Merge remote-tracking branch 'kazu/master'

Conflicts: Language/Haskell/GhcMod/Check.hs Language/Haskell/GhcMod/FillSig.hs Language/Haskell/GhcMod/GHCApi.hs
2014-07-18 17:12:52 +02:00 · 2014-07-18 17:12:52 +02:00 · 6302d4882e
parent 852d742796 0080f9b68c
commit 6302d4882e
28 changed files with 292 additions and 186 deletions
--- a/Language/Haskell/GhcMod.hs
+++ b/Language/Haskell/GhcMod.hs
@ -13,6 +13,14 @@ module Language.Haskell.GhcMod (
  , ModuleString
  , Expression
  , GhcPkgDb
+  , Symbol
+  , SymbolDb
+  -- * Monad Types
+  , GhcModT
+  , IOish
+  -- * Monad utilities
+  , runGhcModT
+  , withOptions
  -- * 'GhcMod' utilities
  , boot
  , browse
@ -20,7 +28,6 @@ module Language.Haskell.GhcMod (
  , checkSyntax
  , debugInfo
  , expandTemplate
-  , findSymbol
  , info
  , lint
  , pkgDoc
@ -32,20 +39,26 @@ module Language.Haskell.GhcMod (
  , modules
  , languages
  , flags
+  , findSymbol
+  , lookupSymbol
+  , dumpSymbol
+  -- * SymbolDb
+  , loadSymbolDb
  ) where

 import Language.Haskell.GhcMod.Boot
 import Language.Haskell.GhcMod.Browse
+import Language.Haskell.GhcMod.CaseSplit
 import Language.Haskell.GhcMod.Check
 import Language.Haskell.GhcMod.Cradle
 import Language.Haskell.GhcMod.Debug
+import Language.Haskell.GhcMod.FillSig
 import Language.Haskell.GhcMod.Find
 import Language.Haskell.GhcMod.Flag
 import Language.Haskell.GhcMod.Info
 import Language.Haskell.GhcMod.Lang
 import Language.Haskell.GhcMod.Lint
 import Language.Haskell.GhcMod.List
+import Language.Haskell.GhcMod.Monad
 import Language.Haskell.GhcMod.PkgDoc
-import Language.Haskell.GhcMod.FillSig
-import Language.Haskell.GhcMod.CaseSplit
 import Language.Haskell.GhcMod.Types
--- a/Language/Haskell/GhcMod/Browse.hs
+++ b/Language/Haskell/GhcMod/Browse.hs
@ -11,11 +11,11 @@ import Exception (ghandle)
 import FastString (mkFastString)
 import GHC (GhcException(CmdLineError), ModuleInfo, Name, TyThing, DynFlags, Type, TyCon)
 import qualified GHC as G
-import Language.Haskell.GhcMod.Doc (showPage, styleUnqualified)
-import Language.Haskell.GhcMod.DynFlags
-import Language.Haskell.GhcMod.Gap
-import Language.Haskell.GhcMod.Monad
 import Language.Haskell.GhcMod.Convert
+import Language.Haskell.GhcMod.Doc (showPage, styleUnqualified)
+import Language.Haskell.GhcMod.Gap
+import Language.Haskell.GhcMod.Monad (IOish, GhcModT, options)
+import Language.Haskell.GhcMod.Target (setTargetFiles)
 import Language.Haskell.GhcMod.Types
 import Name (getOccString)
 import Outputable (ppr, Outputable)
--- a/Language/Haskell/GhcMod/CabalConfig.hs
+++ b/Language/Haskell/GhcMod/CabalConfig.hs
@ -14,6 +14,10 @@ import Language.Haskell.GhcMod.Types
 import qualified Language.Haskell.GhcMod.Cabal16 as C16
 import qualified Language.Haskell.GhcMod.Cabal18 as C18

+#ifndef MIN_VERSION_mtl
+#define MIN_VERSION_mtl(x,y,z) 1
+#endif
+
 import qualified Control.Exception as E
 import Control.Applicative ((<$>))
 import Control.Monad (mplus)
@ -59,7 +63,7 @@ configDependencies :: PackageIdentifier -> CabalConfig -> [Package]
 configDependencies thisPkg config = map fromInstalledPackageId deps
 where
    deps :: [InstalledPackageId]
-    deps = case (deps18 `mplus` deps16) of
+    deps = case deps18 `mplus` deps16 of
        Right ps -> ps
        Left msg -> error msg

--- a/Language/Haskell/GhcMod/CaseSplit.hs
+++ b/Language/Haskell/GhcMod/CaseSplit.hs
@ -184,7 +184,7 @@ getBindingText text srcSpan =
           [T.drop (sc - 1) $ T.take ec $ head lines_]
      else -- several lines
            let (first,rest,last_) = (head lines_, tail $ init lines_, last lines_)
-             in (T.drop (sc - 1) first) : rest ++ [T.take ec last_]
+             in T.drop (sc - 1) first : rest ++ [T.take ec last_]

 srcSpanDifference :: SrcSpan -> SrcSpan -> (Int,Int,Int,Int)
 srcSpanDifference b v =
--- a/Language/Haskell/GhcMod/Check.hs
+++ b/Language/Haskell/GhcMod/Check.hs
@ -9,7 +9,8 @@ import Control.Applicative ((<$>))
 import Language.Haskell.GhcMod.DynFlags
 import qualified Language.Haskell.GhcMod.Gap as Gap
 import Language.Haskell.GhcMod.Logger
-import Language.Haskell.GhcMod.Monad
+import Language.Haskell.GhcMod.Monad (IOish, GhcModT, withErrorHandler)
+import Language.Haskell.GhcMod.Target (setTargetFiles)

 ----------------------------------------------------------------

@ -19,7 +20,7 @@ checkSyntax :: IOish m
            => [FilePath]  -- ^ The target files.
            -> GhcModT m String
 checkSyntax [] = return ""
-checkSyntax files = withErrorHandler sessionName $ do
+checkSyntax files = withErrorHandler sessionName $
    either id id <$> check files
  where
    sessionName = case files of
@ -33,7 +34,7 @@ checkSyntax files = withErrorHandler sessionName $ do
 check :: IOish m
      => [FilePath]  -- ^ The target files.
      -> GhcModT m (Either String String)
-check fileNames = do
+check fileNames =
  withLogger (setAllWaringFlags . setNoMaxRelevantBindings) $
    setTargetFiles fileNames

@ -44,7 +45,7 @@ expandTemplate :: IOish m
               => [FilePath]  -- ^ The target files.
               -> GhcModT m String
 expandTemplate [] = return ""
-expandTemplate files = withErrorHandler sessionName $ do
+expandTemplate files = withErrorHandler sessionName $
    either id id <$> expand files
  where
    sessionName = case files of
--- a/Language/Haskell/GhcMod/Convert.hs
+++ b/Language/Haskell/GhcMod/Convert.hs
@ -81,14 +81,14 @@ instance ToString ((Int,Int,Int,Int),String) where
    toPlain opt x = tupToString opt x

 instance ToString (String, (Int,Int,Int,Int),[String]) where
-    toLisp  opt (s,x,y) = toSexp2 $ [toLisp opt s, ('(' :) . fourIntsToString opt x . (')' :), toLisp opt y]
+    toLisp  opt (s,x,y) = toSexp2 [toLisp opt s, ('(' :) . fourIntsToString opt x . (')' :), toLisp opt y]
    toPlain opt (s,x,y) = inter '\n' [toPlain opt s, fourIntsToString opt x, toPlain opt y]

 toSexp1 :: Options -> [String] -> Builder
 toSexp1 opt ss = ('(' :) . inter ' ' (map (quote opt) ss) . (')' :)

 toSexp2 :: [Builder] -> Builder
-toSexp2 ss = ('(' :) . (inter ' ' ss) . (')' :)
+toSexp2 ss = ('(' :) . inter ' ' ss . (')' :)

 fourIntsToString :: Options -> (Int,Int,Int,Int) -> Builder
 fourIntsToString _ (a,b,c,d) = (show a ++) . (' ' :)
--- a/Language/Haskell/GhcMod/Cradle.hs
+++ b/Language/Haskell/GhcMod/Cradle.hs
@ -22,8 +22,7 @@ import System.FilePath ((</>), takeDirectory)
 --   Find a sandbox according to a cabal sandbox config
 --   in a cabal directory.
 findCradle :: IO Cradle
-findCradle = do
-    findCradle' =<< getCurrentDirectory
+findCradle = findCradle' =<< getCurrentDirectory

 findCradle' :: FilePath -> IO Cradle
 findCradle' dir = cabalCradle dir ||> sandboxCradle dir ||> plainCradle dir
--- a/Language/Haskell/GhcMod/Debug.hs
+++ b/Language/Haskell/GhcMod/Debug.hs
@ -16,7 +16,7 @@ debugInfo :: IOish m => GhcModT m String
 debugInfo = cradle >>= \c -> convert' =<< do
    CompilerOptions gopts incDir pkgs <-
        if isJust $ cradleCabalFile c then
-            (fromCabalFile c ||> simpleCompilerOption)
+            fromCabalFile c ||> simpleCompilerOption
          else
            simpleCompilerOption
    return [
--- a/Language/Haskell/GhcMod/DynFlags.hs
+++ b/Language/Haskell/GhcMod/DynFlags.hs
@ -2,17 +2,14 @@

 module Language.Haskell.GhcMod.DynFlags where

+import Control.Applicative ((<$>))
+import Control.Monad (void)
+import GHC (DynFlags(..), GhcMode(..), GhcLink(..), HscTarget(..))
+import qualified GHC as G
+import GHC.Paths (libdir)
+import GhcMonad
 import qualified Language.Haskell.GhcMod.Gap as Gap
 import Language.Haskell.GhcMod.Types
-
-import Control.Applicative ((<$>))
-import Control.Monad (forM, void, (>=>))
-import GHC (DynFlags(..), GhcMode(..), GhcLink(..), HscTarget(..), LoadHowMuch(..))
-import qualified GHC as G
-import GhcMonad
-import GHC.Paths (libdir)
-import DynFlags (ExtensionFlag(..), xopt)
-
 import System.IO.Unsafe (unsafePerformIO)

 data Build = CabalPkg | SingleFile deriving Eq
@ -71,40 +68,9 @@ addCmdOpts cmdOpts df =

 ----------------------------------------------------------------

-- | Set the files as targets and load them.
-setTargetFiles :: (GhcMonad m) => [FilePath] -> m ()
-setTargetFiles files = do
-    targets <- forM files $ \file -> G.guessTarget file Nothing
-    G.setTargets targets
-    xs <- G.depanal [] False
-    -- FIXME, checking state
-    loadTargets $ needsFallback xs
-  where
-    loadTargets False = do
-        -- Reporting error A and error B
-        void $ G.load LoadAllTargets
-        mss <- filter (\x -> G.ms_hspp_file x `elem` files) <$> G.getModuleGraph
-        -- Reporting error B and error C
-        mapM_ (G.parseModule >=> G.typecheckModule >=> G.desugarModule) mss
-        -- Error B duplicates. But we cannot ignore both error reportings,
-        -- sigh. So, the logger makes log messages unique by itself.
-    loadTargets True = do
-        df <- G.getSessionDynFlags
-        void $ G.setSessionDynFlags (setModeIntelligent df)
-        void $ G.load LoadAllTargets
-
-needsFallback :: G.ModuleGraph -> Bool
-needsFallback = any (hasTHorQQ . G.ms_hspp_opts)
-  where
-    hasTHorQQ :: DynFlags -> Bool
-    hasTHorQQ dflags = any (`xopt` dflags) [Opt_TemplateHaskell, Opt_QuasiQuotes]
-
----------------------------------------------------------------
-
 -- | Return the 'DynFlags' currently in use in the GHC session.
 getDynamicFlags :: IO DynFlags
-getDynamicFlags = do
-    G.runGhc (Just libdir) G.getSessionDynFlags
+getDynamicFlags = G.runGhc (Just libdir) G.getSessionDynFlags

 withDynFlags :: GhcMonad m
             => (DynFlags -> DynFlags)
@ -138,7 +104,7 @@ setAllWaringFlags :: DynFlags -> DynFlags
 setAllWaringFlags df = df { warningFlags = allWarningFlags }

 allWarningFlags :: Gap.WarnFlags
-allWarningFlags = unsafePerformIO $ do
+allWarningFlags = unsafePerformIO $
    G.runGhc (Just libdir) $ do
        df <- G.getSessionDynFlags
        df' <- addCmdOpts ["-Wall"] df
--- a/Language/Haskell/GhcMod/FillSig.hs
+++ b/Language/Haskell/GhcMod/FillSig.hs
@ -6,7 +6,7 @@ module Language.Haskell.GhcMod.FillSig (
  ) where

 import Data.Char (isSymbol)
-import Data.List (find, intercalate)
+import Data.List (find)
 import Data.Maybe (isJust)
 import Exception (ghandle, SomeException(..))
 import GHC (GhcMonad, Id, ParsedModule(..), TypecheckedModule(..), DynFlags, SrcSpan, Type, GenLocated(L))
@ -48,7 +48,7 @@ sig file lineNo colNo = ghandle handler body
        whenFound opt (getSignature modSum lineNo colNo) $ \s -> case s of
          Signature loc names ty ->
            ("function", fourInts loc, map (initialBody dflag style ty) names)
-          InstanceDecl loc cls -> do
+          InstanceDecl loc cls ->
             ("instance", fourInts loc, map (\x -> initialBody dflag style (G.idType x) x)
                                            (Ty.classMethods cls))

@ -112,8 +112,8 @@ initialBody' fname args =
  case initialBodyArgs args infiniteVars infiniteFns of
    []      -> fname
    arglist -> if isSymbolName fname
-               then (head arglist) ++ " " ++ fname ++ " " ++ (intercalate " " (tail arglist))
-               else fname ++ " " ++ (intercalate " " arglist)
+               then head arglist ++ " " ++ fname ++ " " ++ unwords (tail arglist)
+               else fname ++ " " ++ unwords arglist
  ++ " = " ++ (if isSymbolName fname then "" else '_':fname) ++ "_body"

 initialBodyArgs :: [FnArg] -> [String] -> [String] -> [String]
@ -136,11 +136,11 @@ instance FnArgsInfo (G.HsType G.RdrName) (G.RdrName) where
  getFnArgs (G.HsForAllTy _ _ _ (L _ iTy))  = getFnArgs iTy
  getFnArgs (G.HsParTy (L _ iTy))           = getFnArgs iTy
  getFnArgs (G.HsFunTy (L _ lTy) (L _ rTy)) = (if fnarg lTy then FnArgFunction else FnArgNormal):getFnArgs rTy
-    where fnarg = \ty -> case ty of
-                           (G.HsForAllTy _ _ _ (L _ iTy)) -> fnarg iTy
-                           (G.HsParTy (L _ iTy))          -> fnarg iTy
-                           (G.HsFunTy _ _)                -> True
-                           _                              -> False
+    where fnarg ty = case ty of
+              (G.HsForAllTy _ _ _ (L _ iTy)) -> fnarg iTy
+              (G.HsParTy (L _ iTy))          -> fnarg iTy
+              (G.HsFunTy _ _)                -> True
+              _                              -> False
  getFnArgs _ = []

 instance FnArgsInfo (HE.Type HE.SrcSpanInfo) (HE.Name HE.SrcSpanInfo) where
@ -149,11 +149,11 @@ instance FnArgsInfo (HE.Type HE.SrcSpanInfo) (HE.Name HE.SrcSpanInfo) where
  getFnArgs (HE.TyForall _ _ _ iTy) = getFnArgs iTy
  getFnArgs (HE.TyParen _ iTy)      = getFnArgs iTy
  getFnArgs (HE.TyFun _ lTy rTy)    = (if fnarg lTy then FnArgFunction else FnArgNormal):getFnArgs rTy
-    where fnarg = \ty -> case ty of
-                           (HE.TyForall _ _ _ iTy) -> fnarg iTy
-                           (HE.TyParen _ iTy)      -> fnarg iTy
-                           (HE.TyFun _ _ _)        -> True
-                           _                       -> False
+    where fnarg ty = case ty of
+              (HE.TyForall _ _ _ iTy) -> fnarg iTy
+              (HE.TyParen _ iTy)      -> fnarg iTy
+              (HE.TyFun _ _ _)        -> True
+              _                       -> False
  getFnArgs _ = []

 instance FnArgsInfo Type Id where
--- a/Language/Haskell/GhcMod/Find.hs
+++ b/Language/Haskell/GhcMod/Find.hs
@ -1,13 +1,18 @@
 {-# LANGUAGE CPP, BangPatterns #-}

-module Language.Haskell.GhcMod.Find (
+module Language.Haskell.GhcMod.Find
+#ifndef SPEC
+  (
    Symbol
  , SymbolDb
-  , getSymbolDb
+  , loadSymbolDb
  , lookupSymbol
  , dumpSymbol
  , findSymbol
-  ) where
+  , lookupSym
+  )
+#endif
+  where

 import Config (cProjectVersion,cTargetPlatformString)
 import Control.Applicative ((<$>))
@ -19,16 +24,17 @@ import Data.List (groupBy, sort)
 import Data.List.Split (splitOn)
 import Data.Maybe (fromMaybe)
 import DynFlags (DynFlags(..), systemPackageConfig)
-import Exception (handleIO)
+import Exception (ghandle, handleIO)
 import qualified GHC as G
 import Language.Haskell.GhcMod.Convert
 import Language.Haskell.GhcMod.Monad
+import Language.Haskell.GhcMod.Utils
 import Language.Haskell.GhcMod.Types
 import Name (getOccString)
 import System.Directory (doesDirectoryExist, getAppUserDataDirectory, doesFileExist, getModificationTime)
 import System.FilePath ((</>))
 import System.IO
-import System.Process (readProcess)
+import System.Environment (getExecutablePath)

 #ifndef MIN_VERSION_containers
 #define MIN_VERSION_containers(x,y,z) 1
@ -44,11 +50,10 @@ import qualified Data.Map as M

 ----------------------------------------------------------------

-- | Type of key for `SymbolDb`.
+-- | Type of function and operation names.
 type Symbol = String
-type Db = Map Symbol [ModuleString]
-- | Database from 'Symbol' to modules.
-newtype SymbolDb = SymbolDb Db
+-- | Database from 'Symbol' to \['ModuleString'\].
+newtype SymbolDb = SymbolDb (Map Symbol [ModuleString])

 ----------------------------------------------------------------

@ -63,26 +68,37 @@ packageConfDir = "package.conf.d"

 ----------------------------------------------------------------

-- | Finding modules to which the symbol belong.
+-- | Looking up 'SymbolDb' with 'Symbol' to \['ModuleString'\]
+--   which will be concatenated. 'loadSymbolDb' is called internally.
 findSymbol :: IOish m => Symbol -> GhcModT m String
-findSymbol sym = convert' =<< lookupSymbol' sym <$> liftIO getSymbolDb
+findSymbol sym = liftIO loadSymbolDb >>= lookupSymbol sym

-lookupSymbol' :: Symbol -> SymbolDb -> [ModuleString]
-lookupSymbol' sym (SymbolDb db) = fromMaybe [] (M.lookup sym db)
+-- | Looking up 'SymbolDb' with 'Symbol' to \['ModuleString'\]
+--   which will be concatenated.
+lookupSymbol :: IOish m => Symbol -> SymbolDb -> GhcModT m String
+lookupSymbol sym db = convert' $ lookupSym sym db

-- | Looking up 'SymbolDb' with 'Symbol' to find modules.
-lookupSymbol :: Options -> Symbol -> SymbolDb -> String
-lookupSymbol opt sym db = convert opt $ lookupSymbol' sym db
+lookupSym :: Symbol -> SymbolDb -> [ModuleString]
+lookupSym sym (SymbolDb db) = fromMaybe [] $ M.lookup sym db

 ---------------------------------------------------------------

-- | Creating 'SymbolDb'.
-getSymbolDb :: IO SymbolDb
-getSymbolDb = SymbolDb <$> loadSymbolDb
+-- | Loading a file and creates 'SymbolDb'.
+loadSymbolDb :: IO SymbolDb
+loadSymbolDb = SymbolDb <$> readSymbolDb

-loadSymbolDb :: IO Db
-loadSymbolDb = handle (\(SomeException _) -> return M.empty) $ do
-    file <- chop <$> readProcess "ghc-mod" ["dumpsym"] []
+ghcModExecutable :: IO FilePath
+ghcModExecutable =
+#ifndef SPEC
+    getExecutablePath
+#else
+    return "dist/build/ghc-mod/ghc-mod"
+#endif
+
+readSymbolDb :: IO (Map Symbol [ModuleString])
+readSymbolDb = handle (\(SomeException _) -> return M.empty) $ do
+    ghcMod <- ghcModExecutable
+    file <- chop <$> readProcess' ghcMod ["dumpsym"]
    M.fromAscList . map conv . lines <$> readFile file
  where
    conv :: String -> (Symbol,[ModuleString])
@ -101,6 +117,9 @@ getPath = do
        []  -> return Nothing
        u:_ -> liftIO $ resolvePackageDb df u

+-- | Dumping a set of ('Symbol',\['ModuleString'\]) to a file
+--   if the file does not exist or is invalid.
+--   The file name is printed.
 dumpSymbol :: IOish m => GhcModT m String
 dumpSymbol = do
    mdir <- getPath
@ -109,12 +128,12 @@ dumpSymbol = do
        Just dir -> do
            let cache = dir </> symbolCache
                pkgdb = dir </> packageCache
-            do -- fixme: bracket
+            ghandle (\(SomeException _) -> return "") $ do
                create <- liftIO $ needToCreate cache pkgdb
                when create $ do
                    sm <- getSymbol
                    void . liftIO $ withFile cache WriteMode $ \hdl ->
-                        mapM (hPutStrLn hdl . show) sm
+                        mapM (hPrint hdl) sm
                return cache
    return $ ret ++ "\n"

--- a/Language/Haskell/GhcMod/GHCApi.hs
+++ b/Language/Haskell/GhcMod/GHCApi.hs
@ -1,4 +1,4 @@
-{-# LANGUAGE ScopedTypeVariables, RecordWildCards, CPP #-}
+{-# LANGUAGE ScopedTypeVariables #-}

 module Language.Haskell.GhcMod.GHCApi (
    ghcPkgDb
@ -11,7 +11,8 @@ module Language.Haskell.GhcMod.GHCApi (
  ) where

 import Language.Haskell.GhcMod.GhcPkg
-import Language.Haskell.GhcMod.DynFlags
+import Language.Haskell.GhcMod.Monad (IOish, GhcModT)
+import Language.Haskell.GhcMod.Target (setTargetFiles)
 import Language.Haskell.GhcMod.Types

 import Control.Applicative ((<$>))
@ -42,8 +43,7 @@ modules :: G.PackageConfig -> [ModuleString]
 modules = map G.moduleNameString . G.exposedModules

 findModule :: ModuleString -> PkgDb -> [Package]
-findModule m db = do
-  M.elems $ package `M.map` (containsModule `M.filter` db)
+findModule m db = M.elems $ package `M.map` (containsModule `M.filter` db)
 where
    containsModule :: G.PackageConfig -> Bool
    containsModule pkgConf =
@ -65,10 +65,10 @@ type Binding = String
 -- should look for @module@ in the working directory.
 --
 -- To map a 'ModuleString' to a package see 'findModule'
-moduleInfo :: GhcMonad m
+moduleInfo :: IOish m
           => Maybe Package
           -> ModuleString
-           -> m (Maybe G.ModuleInfo)
+           -> GhcModT m (Maybe G.ModuleInfo)
 moduleInfo mpkg mdl = do
    let mdlName = G.mkModuleName mdl
        mfsPkgId = G.packageIdFS . ghcPkgId <$> mpkg
@ -79,9 +79,8 @@ moduleInfo mpkg mdl = do
       Just _ -> return ()
       Nothing -> setTargetFiles [mdl]

-localModuleInfo :: GhcMonad m => ModuleString -> m (Maybe G.ModuleInfo)
+localModuleInfo :: IOish m => ModuleString -> GhcModT m (Maybe G.ModuleInfo)
 localModuleInfo mdl = moduleInfo Nothing mdl

 bindings :: G.ModuleInfo -> [Binding]
-bindings minfo = do
-  map (G.occNameString . G.getOccName) $ G.modInfoExports minfo
+bindings minfo = map (G.occNameString . G.getOccName) $ G.modInfoExports minfo
--- a/Language/Haskell/GhcMod/Gap.hs
+++ b/Language/Haskell/GhcMod/Gap.hs
@ -39,6 +39,7 @@ module Language.Haskell.GhcMod.Gap (
  , GLMatch
  , getClass
  , occName
+  , setFlags
  ) where

 import Control.Applicative hiding (empty)
@ -459,3 +460,13 @@ getClass _ = Nothing
 occName :: RdrName -> OccName
 occName = rdrNameOcc
 #endif
+
+----------------------------------------------------------------
+----------------------------------------------------------------
+
+setFlags :: DynFlags -> DynFlags
+#if __GLASGOW_HASKELL__ >= 708
+setFlags df = df `gopt_unset` Opt_SpecConstr -- consume memory if -O2
+#else
+setFlags = id
+#endif
--- a/Language/Haskell/GhcMod/Ghc.hs
+++ b/Language/Haskell/GhcMod/Ghc.hs
@ -1,6 +0,0 @@
-module Language.Haskell.GhcMod.Ghc (
-    -- * 'SymMdlDb'
-    module Language.Haskell.GhcMod.Find
-  ) where
-
-import Language.Haskell.GhcMod.Find
--- a/Language/Haskell/GhcMod/Internal.hs
+++ b/Language/Haskell/GhcMod/Internal.hs
@ -26,6 +26,26 @@ module Language.Haskell.GhcMod.Internal (
  , withLogger
  , setNoWaringFlags
  , setAllWaringFlags
+  -- * Environment, state and logging
+  , GhcModEnv(..)
+  , newGhcModEnv
+  , GhcModState
+  , defaultState
+  , Mode(..)
+  , GhcModWriter
+  -- * Monad utilities
+  , runGhcMod
+  , runGhcModT'
+  , withErrorHandler
+  -- ** Conversion
+  , liftGhcMod
+  , toGhcModT
+  -- ** Accessing 'GhcModEnv' and 'GhcModState'
+  , options
+  , cradle
+  , getMode
+  , setMode
+  , withOptions
  -- * 'Ghc' Choice
  , (||>)
  , goNext
@ -40,6 +60,8 @@ import Language.Haskell.GhcMod.CabalApi
 import Language.Haskell.GhcMod.DynFlags
 import Language.Haskell.GhcMod.GHCChoice
 import Language.Haskell.GhcMod.Logger
+import Language.Haskell.GhcMod.Monad
+import Language.Haskell.GhcMod.Target
 import Language.Haskell.GhcMod.Types

 -- | Obtaining the directory for ghc system libraries.
--- a/Language/Haskell/GhcMod/Lint.hs
+++ b/Language/Haskell/GhcMod/Lint.hs
@ -6,6 +6,7 @@ import CoreMonad (liftIO)
 import Language.Haskell.GhcMod.Logger (checkErrorPrefix)
 import Language.Haskell.GhcMod.Convert
 import Language.Haskell.GhcMod.Monad
+import Language.Haskell.GhcMod.Types
 import Language.Haskell.HLint (hlint)

 -- | Checking syntax of a target file using hlint.
@ -15,7 +16,7 @@ lint :: IOish m
     -> GhcModT m String
 lint file = do
  opt <- options
-  ghandle handler . pack =<< (liftIO $ hlint $ file : "--quiet" : hlintOpts opt)
+  ghandle handler . pack =<< liftIO (hlint $ file : "--quiet" : hlintOpts opt)
 where
    pack = convert' . map (init . show) -- init drops the last \n.
    handler (SomeException e) = return $ checkErrorPrefix ++ show e ++ "\n"
--- a/Language/Haskell/GhcMod/List.hs
+++ b/Language/Haskell/GhcMod/List.hs
@ -4,8 +4,9 @@ import Control.Applicative ((<$>))
 import Control.Exception (SomeException(..))
 import Data.List (nub, sort)
 import qualified GHC as G
-import Language.Haskell.GhcMod.Monad
 import Language.Haskell.GhcMod.Convert
+import Language.Haskell.GhcMod.Monad
+import Language.Haskell.GhcMod.Types
 import Packages (pkgIdMap, exposedModules, sourcePackageId, display)
 import UniqFM (eltsUFM)

@ -15,7 +16,7 @@ import UniqFM (eltsUFM)
 modules :: IOish m => GhcModT m String
 modules = do
    opt <- options
-    convert opt . (arrange opt) <$> (getModules `G.gcatch` handler)
+    convert opt . arrange opt <$> (getModules `G.gcatch` handler)
  where
    getModules = getExposedModules <$> G.getSessionDynFlags
    getExposedModules = concatMap exposedModules'
--- a/Language/Haskell/GhcMod/Logger.hs
+++ b/Language/Haskell/GhcMod/Logger.hs
@ -1,4 +1,4 @@
-{-# LANGUAGE BangPatterns, CPP #-}
+{-# LANGUAGE CPP #-}

 module Language.Haskell.GhcMod.Logger (
    withLogger
@ -21,6 +21,7 @@ import Language.Haskell.GhcMod.DynFlags (withDynFlags, withCmdFlags)
 import qualified Language.Haskell.GhcMod.Gap as Gap
 import Language.Haskell.GhcMod.Convert (convert')
 import Language.Haskell.GhcMod.Monad
+import Language.Haskell.GhcMod.Types
 import Outputable (PprStyle, SDoc)
 import System.FilePath (normalise)

@ -62,9 +63,9 @@ withLogger :: IOish m
           -> GhcModT m ()
           -> GhcModT m (Either String String)
 withLogger setDF body = ghandle sourceError $ do
-    logref <- liftIO $ newLogRef
+    logref <- liftIO newLogRef
    wflags <- filter ("-fno-warn" `isPrefixOf`) . ghcOpts <$> options
-    withDynFlags (setLogger logref . setDF) $ do
+    withDynFlags (setLogger logref . setDF) $
        withCmdFlags wflags $ do
            body
            Right <$> readAndClearLogRef logref
@ -78,8 +79,8 @@ withLogger setDF body = ghandle sourceError $ do
 sourceError :: IOish m => SourceError -> GhcModT m (Either String String)
 sourceError err = do
    dflags <- G.getSessionDynFlags
-    style <- toGhcMod getStyle
-    ret <- convert' $ (errBagToStrList dflags style . srcErrorMessages $ err)
+    style <- toGhcModT getStyle
+    ret <- convert' (errBagToStrList dflags style . srcErrorMessages $ err)
    return $ Left ret

 errBagToStrList :: DynFlags -> PprStyle -> Bag ErrMsg -> [String]
--- a/Language/Haskell/GhcMod/Monad.hs
+++ b/Language/Haskell/GhcMod/Monad.hs
@ -5,27 +5,36 @@
 {-# OPTIONS_GHC -fno-warn-orphans #-}

 module Language.Haskell.GhcMod.Monad (
-   GhcMod
- , runGhcMod
- , liftGhcMod
- , GhcModT
- , IOish
- , GhcModEnv(..)
- , GhcModWriter
- , GhcModState(..)
- , runGhcModT'
- , runGhcModT
- , newGhcModEnv
- , withErrorHandler
- , toGhcMod
- , options
- , cradle
- , Options(..)
- , defaultOptions
- , module Control.Monad.Reader.Class
- , module Control.Monad.Writer.Class
- , module Control.Monad.State.Class
- ) where
+  -- * Monad Types
+    GhcMod
+  , GhcModT
+  , IOish
+  -- ** Environment, state and logging
+  , GhcModEnv(..)
+  , newGhcModEnv
+  , GhcModState
+  , defaultState
+  , Mode(..)
+  , GhcModWriter
+  -- * Monad utilities
+  , runGhcMod
+  , runGhcModT
+  , runGhcModT'
+  , withErrorHandler
+  -- ** Conversion
+  , liftGhcMod
+  , toGhcModT
+  -- ** Accessing 'GhcModEnv' and 'GhcModState'
+  , options
+  , cradle
+  , getMode
+  , setMode
+  , withOptions
+  -- ** Exporting convenient modules
+  , module Control.Monad.Reader.Class
+  , module Control.Monad.Writer.Class
+  , module Control.Monad.State.Class
+  ) where

 #if __GLASGOW_HASKELL__ < 708
 -- 'CoreMonad.MonadIO' and 'Control.Monad.IO.Class.MonadIO' are different
@ -97,10 +106,12 @@ data GhcModEnv = GhcModEnv {
    , gmCradle     :: Cradle
    }

-data GhcModState = GhcModState deriving (Eq,Show,Read)
+data GhcModState = GhcModState Mode deriving (Eq,Show,Read)
+
+data Mode = Simple | Intelligent deriving (Eq,Show,Read)

 defaultState :: GhcModState
-defaultState = GhcModState
+defaultState = GhcModState Simple

 type GhcModWriter = ()

@ -188,8 +199,9 @@ initSession :: GhcMonad m
            -> m ()
 initSession build Options {..} CompilerOptions {..} = do
    df <- G.getSessionDynFlags
-    void $ G.setSessionDynFlags =<< (addCmdOpts ghcOptions
-      $ setModeSimple
+    void $ G.setSessionDynFlags =<< addCmdOpts ghcOptions
+      ( setModeSimple
+      $ Gap.setFlags
      $ setIncludeDirs includeDirs
      $ setBuildEnv build
      $ setEmptyLogger
@ -263,8 +275,8 @@ withErrorHandler label = ghandle ignore
        exitSuccess

 -- | This is only a transitional mechanism don't use it for new code.
-toGhcMod :: IOish m => Ghc a -> GhcModT m a
-toGhcMod a = do
+toGhcModT :: IOish m => Ghc a -> GhcModT m a
+toGhcModT a = do
    s <- gmGhcSession <$> ask
    liftIO $ unGhc a $ Session s

@ -276,6 +288,25 @@ options = gmOptions <$> ask
 cradle :: IOish m => GhcModT m Cradle
 cradle = gmCradle <$> ask

+getMode :: IOish m => GhcModT m Mode
+getMode = do
+    GhcModState mode <- get
+    return mode
+
+setMode :: IOish m => Mode -> GhcModT m ()
+setMode mode = put $ GhcModState mode
+
+----------------------------------------------------------------
+
+withOptions :: IOish m => (Options -> Options) -> GhcModT m a -> GhcModT m a
+withOptions changeOpt action = local changeEnv action
+  where
+    changeEnv e = e { gmOptions = changeOpt opt }
+      where
+        opt = gmOptions e
+
+----------------------------------------------------------------
+
 instance (MonadBaseControl IO m) => MonadBase IO (GhcModT m) where
    liftBase = GhcModT . liftBase

--- a/Language/Haskell/GhcMod/SrcUtils.hs
+++ b/Language/Haskell/GhcMod/SrcUtils.hs
@ -9,17 +9,19 @@ import Data.Generics
 import Data.Maybe (fromMaybe)
 import Data.Ord as O
 import GHC (LHsExpr, LPat, Id, DynFlags, SrcSpan, Type, Located, ParsedSource, RenamedSource, TypecheckedSource, GenLocated(L))
-import GhcMonad
 import qualified GHC as G
 import GHC.SYB.Utils (Stage(..), everythingStaged)
+import GhcMonad
+import qualified Language.Haskell.Exts.Annotated as HE
 import Language.Haskell.GhcMod.Doc (showOneLine, getStyle)
 import Language.Haskell.GhcMod.DynFlags
 import Language.Haskell.GhcMod.Gap (HasType(..), setWarnTypedHoles, setDeferTypeErrors)
 import qualified Language.Haskell.GhcMod.Gap as Gap
+import Language.Haskell.GhcMod.Monad (IOish, GhcModT)
+import Language.Haskell.GhcMod.Target (setTargetFiles)
+import OccName (OccName)
 import Outputable (PprStyle)
 import TcHsSyn (hsPatType)
-import OccName (OccName)
-import qualified Language.Haskell.Exts.Annotated as HE

 ----------------------------------------------------------------

@ -79,7 +81,7 @@ pretty dflag style = showOneLine dflag style . Gap.typeForUser

 ----------------------------------------------------------------

-inModuleContext ::GhcMonad m => FilePath -> (DynFlags -> PprStyle -> m a) -> m a
+inModuleContext :: IOish m => FilePath -> (DynFlags -> PprStyle -> GhcModT m a) -> GhcModT m a
 inModuleContext file action =
    withDynFlags (setWarnTypedHoles . setDeferTypeErrors . setNoWaringFlags) $ do
    setTargetFiles [file]
--- a/Language/Haskell/GhcMod/Target.hs
+++ b/Language/Haskell/GhcMod/Target.hs
@ -0,0 +1,39 @@
+module Language.Haskell.GhcMod.Target (
+    setTargetFiles
+  ) where
+
+import Control.Applicative ((<$>))
+import Control.Monad (forM, void, (>=>))
+import DynFlags (ExtensionFlag(..), xopt)
+import GHC (DynFlags(..), LoadHowMuch(..))
+import qualified GHC as G
+import Language.Haskell.GhcMod.DynFlags
+import Language.Haskell.GhcMod.Monad (IOish, GhcModT)
+
+-- | Set the files as targets and load them.
+setTargetFiles :: IOish m => [FilePath] -> GhcModT m ()
+setTargetFiles files = do
+    targets <- forM files $ \file -> G.guessTarget file Nothing
+    G.setTargets targets
+    xs <- G.depanal [] False
+    -- FIXME, checking state
+    loadTargets $ needsFallback xs
+  where
+    loadTargets False = do
+        -- Reporting error A and error B
+        void $ G.load LoadAllTargets
+        mss <- filter (\x -> G.ms_hspp_file x `elem` files) <$> G.getModuleGraph
+        -- Reporting error B and error C
+        mapM_ (G.parseModule >=> G.typecheckModule >=> G.desugarModule) mss
+        -- Error B duplicates. But we cannot ignore both error reportings,
+        -- sigh. So, the logger makes log messages unique by itself.
+    loadTargets True = do
+        df <- G.getSessionDynFlags
+        void $ G.setSessionDynFlags (setModeIntelligent df)
+        void $ G.load LoadAllTargets
+
+needsFallback :: G.ModuleGraph -> Bool
+needsFallback = any (hasTHorQQ . G.ms_hspp_opts)
+  where
+    hasTHorQQ :: DynFlags -> Bool
+    hasTHorQQ dflags = any (`xopt` dflags) [Opt_TemplateHaskell, Opt_QuasiQuotes]
--- a/Language/Haskell/GhcMod/Utils.hs
+++ b/Language/Haskell/GhcMod/Utils.hs
@ -1,5 +1,6 @@
 module Language.Haskell.GhcMod.Utils where

+import MonadUtils (MonadIO, liftIO)
 import Control.Exception (bracket)
 import System.Directory (getCurrentDirectory, setCurrentDirectory)
 import System.Process (readProcessWithExitCode)
@ -18,16 +19,16 @@ extractParens str = extractParens' str 0
   extractParens' (s:ss) level
       | s `elem` "([{" = s : extractParens' ss (level+1)
       | level == 0 = extractParens' ss 0
-       | s `elem` "}])" && level == 1 = s:[]
+       | s `elem` "}])" && level == 1 = [s]
       | s `elem` "}])" = s : extractParens' ss (level-1)
       | otherwise = s : extractParens' ss level

-readProcess' :: String -> [String] -> IO String
+readProcess' :: MonadIO m => String -> [String] -> m String
 readProcess' cmd opts = do
-  (rv,output,err) <- readProcessWithExitCode cmd opts ""
+  (rv,output,err) <- liftIO $ readProcessWithExitCode cmd opts ""
  case rv of
    ExitFailure val -> do
-        hPutStrLn stderr err
+        liftIO $ hPutStrLn stderr err
        fail $ cmd ++ " " ++ unwords opts ++ " (exit " ++ show val ++ ")"
    ExitSuccess ->
        return output
--- a/ghc-mod.cabal
+++ b/ghc-mod.cabal
@ -53,19 +53,17 @@ Library
  GHC-Options:          -Wall
  Default-Extensions:   ConstraintKinds, FlexibleContexts
  Exposed-Modules:      Language.Haskell.GhcMod
-                        Language.Haskell.GhcMod.Ghc
-                        Language.Haskell.GhcMod.Monad
                        Language.Haskell.GhcMod.Internal
  Other-Modules:        Language.Haskell.GhcMod.Boot
                        Language.Haskell.GhcMod.Browse
-                        Language.Haskell.GhcMod.CabalApi
-                        Language.Haskell.GhcMod.CabalConfig
                        Language.Haskell.GhcMod.Cabal16
                        Language.Haskell.GhcMod.Cabal18
+                        Language.Haskell.GhcMod.CabalApi
+                        Language.Haskell.GhcMod.CabalConfig
                        Language.Haskell.GhcMod.CaseSplit
                        Language.Haskell.GhcMod.Check
-                        Language.Haskell.GhcMod.Cradle
                        Language.Haskell.GhcMod.Convert
+                        Language.Haskell.GhcMod.Cradle
                        Language.Haskell.GhcMod.Debug
                        Language.Haskell.GhcMod.Doc
                        Language.Haskell.GhcMod.DynFlags
@ -76,16 +74,18 @@ Library
                        Language.Haskell.GhcMod.GHCChoice
                        Language.Haskell.GhcMod.Gap
                        Language.Haskell.GhcMod.GhcPkg
-                        Language.Haskell.GhcMod.Logger
                        Language.Haskell.GhcMod.Info
                        Language.Haskell.GhcMod.Lang
                        Language.Haskell.GhcMod.Lint
                        Language.Haskell.GhcMod.List
+                        Language.Haskell.GhcMod.Logger
+                        Language.Haskell.GhcMod.Monad
                        Language.Haskell.GhcMod.PkgDoc
-                        Language.Haskell.GhcMod.Utils
-                        Language.Haskell.GhcMod.Types
                        Language.Haskell.GhcMod.Read
                        Language.Haskell.GhcMod.SrcUtils
+                        Language.Haskell.GhcMod.Target
+                        Language.Haskell.GhcMod.Types
+                        Language.Haskell.GhcMod.Utils
  Build-Depends:        base >= 4.0 && < 5
                      , containers
                      , deepseq
@ -198,6 +198,7 @@ Test-Suite spec
    Build-Depends:      Cabal >= 1.18
  if impl(ghc < 7.6.0)
    Build-Depends:      executable-path
+  CPP-Options:        -DSPEC=1

 Source-Repository head
  Type:                 git
--- a/src/GHCMod.hs
+++ b/src/GHCMod.hs
@ -10,8 +10,6 @@ import qualified Control.Exception as E
 import Data.Typeable (Typeable)
 import Data.Version (showVersion)
 import Language.Haskell.GhcMod
-import Language.Haskell.GhcMod.Ghc
-import Language.Haskell.GhcMod.Monad
 import Paths_ghc_mod
 import System.Console.GetOpt (OptDescr(..), ArgDescr(..), ArgOrder(..))
 import qualified System.Console.GetOpt as O
--- a/src/GHCModi.hs
+++ b/src/GHCModi.hs
@ -31,11 +31,8 @@ import Data.Set (Set)
 import qualified Data.Set as S
 import Data.Typeable (Typeable)
 import Data.Version (showVersion)
-import GHC (GhcMonad)
 import qualified GHC as G
 import Language.Haskell.GhcMod
-import Language.Haskell.GhcMod.Ghc
-import Language.Haskell.GhcMod.Monad
 import Paths_ghc_mod
 import System.Console.GetOpt
 import System.Directory (setCurrentDirectory)
@ -116,7 +113,7 @@ replace (x:xs)    =  x  : replace xs
 ----------------------------------------------------------------

 setupDB :: MVar SymbolDb -> IO ()
-setupDB mvar = getSymbolDb >>= putMVar mvar
+setupDB mvar = loadSymbolDb >>= putMVar mvar

 ----------------------------------------------------------------

@ -154,14 +151,14 @@ checkStx :: IOish m
         -> FilePath
         -> GhcModT m (String, Bool, Set FilePath)
 checkStx set file = do
-    set' <- toGhcMod $ newFileSet set file
+    set' <- newFileSet set file
    let files = S.toList set'
    eret <- check files
    case eret of
        Right ret -> return (ret, True, set')
        Left ret  -> return (ret, True, set) -- fxime: set

-newFileSet :: GhcMonad m => Set FilePath -> FilePath -> m (Set FilePath)
+newFileSet :: IOish m => Set FilePath -> FilePath -> GhcModT m (Set FilePath)
 newFileSet set file = do
    let set1
         | S.member file set = set
@ -171,7 +168,7 @@ newFileSet set file = do
        Nothing       -> set1
        Just mainfile -> S.delete mainfile set1

-getModSummaryForMain :: GhcMonad m => m (Maybe G.ModSummary)
+getModSummaryForMain :: IOish m => GhcModT m (Maybe G.ModSummary)
 getModSummaryForMain = find isMain <$> G.getModuleGraph
  where
    isMain m = G.moduleNameString (G.moduleName (G.ms_mod m)) == "Main"
@ -193,21 +190,19 @@ findSym :: IOish m => Set FilePath -> String -> MVar SymbolDb
        -> GhcModT m (String, Bool, Set FilePath)
 findSym set sym mvar = do
    db <- liftIO $ readMVar mvar
-    opt <- options
-    let ret = lookupSymbol opt sym db
+    ret <- lookupSymbol sym db
    return (ret, True, set)

 lintStx :: IOish m => Set FilePath
        -> FilePath
        -> GhcModT m (String, Bool, Set FilePath)
 lintStx set optFile = do
-    ret <- local env' $ lint file
+    ret <- withOptions changeOpt $ lint file
    return (ret, True, set)
  where
    (opts,file) = parseLintOptions optFile
    hopts = if opts == "" then [] else read opts
-    env' e = e { gmOptions = opt' $ gmOptions e }
-    opt' o = o { hlintOpts = hopts }
+    changeOpt o = o { hlintOpts = hopts }

 -- |
 -- >>> parseLintOptions "[\"--ignore=Use camelCase\", \"--ignore=Eta reduce\"] file name"
--- a/test/CheckSpec.hs
+++ b/test/CheckSpec.hs
@ -2,7 +2,6 @@ module CheckSpec where

 import Data.List (isSuffixOf, isInfixOf, isPrefixOf)
 import Language.Haskell.GhcMod
-import Language.Haskell.GhcMod.Cradle
 import System.FilePath
 import Test.Hspec

--- a/test/FindSpec.hs
+++ b/test/FindSpec.hs
@ -0,0 +1,16 @@
+module FindSpec where
+
+import Control.Applicative ((<$>))
+import Data.List (isPrefixOf)
+import Language.Haskell.GhcMod.Find
+import Test.Hspec
+import TestUtils
+
+import qualified Data.Map
+
+spec :: Spec
+spec = do
+    describe "db <- loadSymbolDb" $ do
+        it "lookupSymbol' db \"head\"  contains at least `Data.List'" $ do
+            db <- loadSymbolDb
+            lookupSym "head" db `shouldContain` ["Data.List"]
--- a/test/InfoSpec.hs
+++ b/test/InfoSpec.hs
@ -4,7 +4,6 @@ module InfoSpec where
 import Control.Applicative ((<$>))
 import Data.List (isPrefixOf)
 import Language.Haskell.GhcMod
-import Language.Haskell.GhcMod.Cradle
 #if __GLASGOW_HASKELL__ < 706
 import System.Environment.Executable (getExecutablePath)
 #else
@ -22,38 +21,32 @@ spec = do
    describe "types" $ do
        it "shows types of the expression and its outers" $ do
            withDirectory_ "test/data/ghc-mod-check" $ do
-                cradle <- findCradleWithoutSandbox
                res <- runD $ types "Data/Foo.hs" 9 5
                res `shouldBe` "9 5 11 40 \"Int -> a -> a -> a\"\n7 1 11 40 \"Int -> Integer\"\n"

        it "works with a module using TemplateHaskell" $ do
            withDirectory_ "test/data" $ do
-                cradle <- findCradleWithoutSandbox
                res <- runD $ types "Bar.hs" 5 1
                res `shouldBe` unlines ["5 1 5 20 \"[Char]\""]

        it "works with a module that imports another module using TemplateHaskell" $ do
            withDirectory_ "test/data" $ do
-                cradle <- findCradleWithoutSandbox
                res <- runD $ types "Main.hs" 3 8
                res `shouldBe` unlines ["3 8 3 16 \"String -> IO ()\"", "3 8 3 20 \"IO ()\"", "3 1 3 20 \"IO ()\""]

    describe "info" $ do
        it "works for non-export functions" $ do
            withDirectory_ "test/data" $ do
-                cradle <- findCradleWithoutSandbox
                res <- runD $ info "Info.hs" "fib"
                res `shouldSatisfy` ("fib :: Int -> Int" `isPrefixOf`)

        it "works with a module using TemplateHaskell" $ do
            withDirectory_ "test/data" $ do
-                cradle <- findCradleWithoutSandbox
                res <- runD $ info "Bar.hs" "foo"
                res `shouldSatisfy` ("foo :: ExpQ" `isPrefixOf`)

        it "works with a module that imports another module using TemplateHaskell" $ do
            withDirectory_ "test/data" $ do
-                cradle <- findCradleWithoutSandbox
                res <- runD $ info "Main.hs" "bar"
                res `shouldSatisfy` ("bar :: [Char]" `isPrefixOf`)