Refactoring to use cabal-helper-wrapper

This turned out to be quite involved but save for this huge commit it's actually quite awesome and squashes quite a few bugs and nasty problems (hopefully). Most importantly we now have native cabal component support without the user having to do anything to get it! To do this we traverse imports starting from each component's entrypoints (library modules or Main source file for executables) and use this information to find which component's options each module will build with. Under the assumption that these modules have to build with every component they're used in we can now just pick one. Quite a few internal assumptions have been invalidated by this change. Most importantly the runGhcModT* family of cuntions now change the current working directory to `cradleRootDir`.
2015-03-03 21:12:43 +01:00 · 2015-03-03 21:12:43 +01:00 · 82bb0090c0
parent 7438539ca5
commit 82bb0090c0
43 changed files with 1951 additions and 1844 deletions
--- a/Language/Haskell/GhcMod.hs
+++ b/Language/Haskell/GhcMod.hs
@ -9,6 +9,11 @@ module Language.Haskell.GhcMod (
  , LineSeparator(..)
  , OutputStyle(..)
  , defaultOptions
+  -- * Logging
+  , GmLogLevel
+  , increaseLogLevel
+  , gmSetLogLevel
+  , gmLog
  -- * Types
  , ModuleString
  , Expression
@ -61,7 +66,8 @@ import Language.Haskell.GhcMod.Flag
 import Language.Haskell.GhcMod.Info
 import Language.Haskell.GhcMod.Lang
 import Language.Haskell.GhcMod.Lint
-import Language.Haskell.GhcMod.Monad
+import Language.Haskell.GhcMod.Logging
 import Language.Haskell.GhcMod.Modules
+import Language.Haskell.GhcMod.Monad
 import Language.Haskell.GhcMod.PkgDoc
 import Language.Haskell.GhcMod.Types
--- a/Language/Haskell/GhcMod/Browse.hs
+++ b/Language/Haskell/GhcMod/Browse.hs
@ -4,52 +4,54 @@ module Language.Haskell.GhcMod.Browse (

 import Control.Applicative ((<$>))
 import Control.Exception (SomeException(..))
-import Data.Char (isAlpha)
-import Data.List (sort)
-import Data.Maybe (catMaybes)
-import Exception (ghandle)
-import FastString (mkFastString)
-import GHC (GhcException(CmdLineError), ModuleInfo, Name, TyThing, DynFlags, Type, TyCon)
+import Data.Char
+import Data.List
+import Data.Maybe
+import FastString
+import GHC
 import qualified GHC as G
 import Language.Haskell.GhcMod.Convert
 import Language.Haskell.GhcMod.Doc (showPage, styleUnqualified)
 import Language.Haskell.GhcMod.Gap as Gap
-import Language.Haskell.GhcMod.Monad (GhcModT, options)
-import Language.Haskell.GhcMod.Target (setTargetFiles)
+import Language.Haskell.GhcMod.Monad
 import Language.Haskell.GhcMod.Types
 import Name (getOccString)
-import Outputable (ppr, Outputable)
+import Outputable
 import TyCon (isAlgTyCon)
 import Type (dropForAlls, splitFunTy_maybe, mkFunTy, isPredTy)
+import Exception (ExceptionMonad, ghandle)

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

 -- | Getting functions, classes, etc from a module.
 --   If 'detailed' is 'True', their types are also obtained.
 --   If 'operators' is 'True', operators are also returned.
-browse :: IOish m
+browse :: forall m. IOish m
       => ModuleString -- ^ A module name. (e.g. \"Data.List\")
       -> GhcModT m String
-browse pkgmdl = convert' . sort =<< (listExports =<< getModule)
+browse pkgmdl = do
+    convert' . sort =<< go
  where
+    -- TODO: Add API to Gm.Target to check if module is home module without
+    -- bringing up a GHC session as well then this can be made a lot cleaner
+    go = ghandle (\(SomeException _) -> return []) $ do
+      goPkgModule `G.gcatch` (\(SomeException _) -> goHomeModule)
+
+    goPkgModule = do
+      opt <- options
+      runGmPkgGhc $
+        processExports opt =<< tryModuleInfo =<< G.findModule mdlname mpkgid
+
+    goHomeModule = runGmLoadedT [Right mdlname] $ do
+      opt <- options
+      processExports opt =<< tryModuleInfo =<< G.findModule mdlname Nothing
+
+    tryModuleInfo m = fromJust <$> G.getModuleInfo m
+
    (mpkg,mdl) = splitPkgMdl pkgmdl
    mdlname = G.mkModuleName mdl
    mpkgid = mkFastString <$> mpkg
-    listExports Nothing       = return []
-    listExports (Just mdinfo) = processExports mdinfo
-    -- findModule works only for package modules, moreover,
-    -- you cannot load a package module. On the other hand,
-    -- to browse a local module you need to load it first.
-    -- If CmdLineError is signalled, we assume the user
-    -- tried browsing a local module.
-    getModule = browsePackageModule `G.gcatch` fallback `G.gcatch` handler
-    browsePackageModule = G.findModule mdlname mpkgid >>= G.getModuleInfo
-    browseLocalModule = ghandle handler $ do
-      setTargetFiles [mdl]
-      G.findModule mdlname Nothing >>= G.getModuleInfo
-    fallback (CmdLineError _) = browseLocalModule
-    fallback _                = return Nothing
-    handler (SomeException _) = return Nothing
+
 -- |
 --
 -- >>> splitPkgMdl "base:Prelude"
@ -71,22 +73,23 @@ isNotOp :: String -> Bool
 isNotOp (h:_) = isAlpha h || (h == '_')
 isNotOp _ = error "isNotOp"

-processExports :: IOish m => ModuleInfo -> GhcModT m [String]
-processExports minfo = do
-  opt <- options
+processExports :: (G.GhcMonad m, MonadIO m, ExceptionMonad m)
+               => Options -> ModuleInfo -> m [String]
+processExports opt minfo = do
  let
    removeOps
      | operators opt = id
      | otherwise = filter (isNotOp . getOccString)
  mapM (showExport opt minfo) $ removeOps $ G.modInfoExports minfo

-showExport :: IOish m => Options -> ModuleInfo -> Name -> GhcModT m String
+showExport :: forall m. (G.GhcMonad m, MonadIO m, ExceptionMonad m)
+           => Options -> ModuleInfo -> Name -> m String
 showExport opt minfo e = do
  mtype' <- mtype
  return $ concat $ catMaybes [mqualified, Just $ formatOp $ getOccString e, mtype']
  where
    mqualified = (G.moduleNameString (G.moduleName $ G.nameModule e) ++ ".") `justIf` qualified opt
-    mtype :: IOish m => GhcModT m (Maybe String)
+    mtype :: m (Maybe String)
    mtype
      | detailed opt = do
        tyInfo <- G.modInfoLookupName minfo e
@ -101,8 +104,9 @@ showExport opt minfo e = do
      | null nm    = error "formatOp"
      | isNotOp nm = nm
      | otherwise  = "(" ++ nm ++ ")"
-    inOtherModule :: IOish m => Name -> GhcModT m (Maybe TyThing)
-    inOtherModule nm = G.getModuleInfo (G.nameModule nm) >> G.lookupGlobalName nm
+    inOtherModule :: Name -> m (Maybe TyThing)
+    inOtherModule nm = do
+      G.getModuleInfo (G.nameModule nm) >> G.lookupGlobalName nm
    justIf :: a -> Bool -> Maybe a
    justIf x True = Just x
    justIf _ False = Nothing
--- a/Language/Haskell/GhcMod/CabalApi.hs
+++ b/Language/Haskell/GhcMod/CabalApi.hs
@ -1,144 +0,0 @@
-{-# LANGUAGE OverloadedStrings, CPP #-}
-
-module Language.Haskell.GhcMod.CabalApi (
-    getCompilerOptions
-  , parseCabalFile
-  , cabalAllBuildInfo
-  , cabalSourceDirs
-  , cabalConfigDependencies
-  ) where
-
-import Language.Haskell.GhcMod.CabalConfig
-import Language.Haskell.GhcMod.Error
-import Language.Haskell.GhcMod.Gap (benchmarkBuildInfo, mkGHCCompilerId)
-import Language.Haskell.GhcMod.GhcPkg
-import Language.Haskell.GhcMod.Types
-import Language.Haskell.GhcMod.Logging
-
-import MonadUtils (liftIO)
-import Control.Applicative ((<$>))
-import qualified Control.Exception as E
-import Data.Maybe (maybeToList)
-import Data.Set (fromList, toList)
-import Distribution.Package (PackageName(PackageName))
-import qualified Distribution.Package as C
-import Distribution.PackageDescription (PackageDescription, BuildInfo)
-import qualified Distribution.PackageDescription as P
-import Distribution.PackageDescription.Configuration (finalizePackageDescription)
-import Distribution.PackageDescription.Parse (readPackageDescription)
-import Distribution.Simple.Program as C (ghcProgram)
-import Distribution.Simple.Program.Types (programName, programFindVersion)
-import Distribution.System (buildPlatform)
-import Distribution.Text (display)
-import Distribution.Verbosity (silent)
-import Distribution.Version (Version)
-import System.Directory (doesFileExist)
-import System.FilePath ((</>))
----------------------------------------------------------------
-
-- | Getting necessary 'CompilerOptions' from three information sources.
-getCompilerOptions :: (IOish m, GmError m, GmLog m)
-                   => [GHCOption]
-                   -> Cradle
-                   -> CabalConfig
-                   -> PackageDescription
-                   -> m CompilerOptions
-getCompilerOptions ghcopts cradle config pkgDesc = do
-    gopts <- liftIO $ getGHCOptions ghcopts cradle rdir $ head buildInfos
-    let depPkgs = cabalConfigDependencies config (C.packageId pkgDesc)
-    return $ CompilerOptions gopts idirs depPkgs
-  where
-    wdir       = cradleCurrentDir cradle
-    rdir       = cradleRootDir    cradle
-    buildInfos = cabalAllBuildInfo pkgDesc
-    idirs      = includeDirectories rdir wdir $ cabalSourceDirs buildInfos
-
----------------------------------------------------------------
-- Include directories for modules
-
-cabalBuildDirs :: [FilePath]
-cabalBuildDirs = ["dist/build", "dist/build/autogen"]
-
-includeDirectories :: FilePath -> FilePath -> [FilePath] -> [FilePath]
-includeDirectories cdir wdir dirs = uniqueAndSort (extdirs ++ [cdir,wdir])
-  where
-    extdirs = map expand $ dirs ++ cabalBuildDirs
-    expand "."    = cdir
-    expand subdir = cdir </> subdir
-
----------------------------------------------------------------
-
-- | Parse a cabal file and return a 'PackageDescription'.
-parseCabalFile :: (IOish m, GmError m, GmLog m)
-               => CabalConfig
-               -> FilePath
-               -> m PackageDescription
-parseCabalFile  config file = do
-    cid <- mkGHCCompilerId <$> liftIO getGHCVersion
-    epgd <- liftIO $ readPackageDescription silent file
-    flags <- cabalConfigFlags config
-    case toPkgDesc cid flags epgd of
-        Left deps    -> fail $ show deps ++ " are not installed"
-        Right (pd,_) -> if nullPkg pd
-                        then fail $ file ++ " is broken"
-                        else return pd
-  where
-    toPkgDesc cid flags =
-        finalizePackageDescription flags (const True) buildPlatform cid []
-    nullPkg pd = name == ""
-      where
-        PackageName name = C.pkgName (P.package pd)
-
-getGHCVersion :: IO Version
-getGHCVersion = do
-    mv <- programFindVersion C.ghcProgram silent (programName C.ghcProgram)
-    case mv of
-      -- TODO: MonadError it up
-        Nothing -> E.throwIO $ userError "ghc not found"
-        Just v  -> return v
-
----------------------------------------------------------------
-
-getGHCOptions :: [GHCOption] -> Cradle -> FilePath -> BuildInfo -> IO [GHCOption]
-getGHCOptions ghcopts cradle rdir binfo = do
-    cabalCpp <- cabalCppOptions rdir
-    let cpps = map ("-optP" ++) $ P.cppOptions binfo ++ cabalCpp
-    return $ ghcopts ++ pkgDb ++ exts ++ [lang] ++ libs ++ libDirs ++ cpps
-  where
-    pkgDb = ghcDbStackOpts $ cradlePkgDbStack cradle
-    lang = maybe "-XHaskell98" (("-X" ++) . display) $ P.defaultLanguage binfo
-    libDirs = map ("-L" ++) $ P.extraLibDirs binfo
-    exts = map (("-X" ++) . display) $ P.usedExtensions binfo
-    libs = map ("-l" ++) $ P.extraLibs binfo
-
-cabalCppOptions :: FilePath -> IO [String]
-cabalCppOptions dir = do
-    exist <- doesFileExist cabalMacro
-    return $ if exist then
-        ["-include", cabalMacro]
-      else
-        []
-  where
-    cabalMacro = dir </> "dist/build/autogen/cabal_macros.h"
-
----------------------------------------------------------------
-
-- | Extracting all 'BuildInfo' for libraries, executables, and tests.
-cabalAllBuildInfo :: PackageDescription -> [BuildInfo]
-cabalAllBuildInfo pd = libBI ++ execBI ++ testBI ++ benchBI
-  where
-    libBI   = map P.libBuildInfo       $ maybeToList $ P.library pd
-    execBI  = map P.buildInfo          $ P.executables pd
-    testBI  = map P.testBuildInfo      $ P.testSuites pd
-    benchBI = benchmarkBuildInfo pd
-
----------------------------------------------------------------
-
-- | Extracting include directories for modules.
-cabalSourceDirs :: [BuildInfo] -> [IncludeDir]
-cabalSourceDirs bis = uniqueAndSort $ concatMap P.hsSourceDirs bis
-
----------------------------------------------------------------
-
-uniqueAndSort :: [String] -> [String]
-uniqueAndSort = toList . fromList
--- a/Language/Haskell/GhcMod/CabalConfig.hs
+++ b/Language/Haskell/GhcMod/CabalConfig.hs
@ -1,35 +0,0 @@
-{-# LANGUAGE CPP #-}
-
-- | This module abstracts extracting information from Cabal's on-disk
-- 'LocalBuildInfo' (@dist/setup-config@) for different version combinations of
-- Cabal and GHC.
-module Language.Haskell.GhcMod.CabalConfig (
-    CabalConfig
-  , cabalGetConfig
-  , cabalConfigDependencies
-  , cabalConfigFlags
-  ) where
-
-import Distribution.Package (PackageIdentifier)
-import Distribution.PackageDescription (FlagAssignment)
-
-import Language.Haskell.GhcMod.Types
-import Language.Haskell.GhcMod.Error
-
-import Language.Haskell.GhcMod.CabalConfig.Extract
-
-cabalGetConfig :: (IOish m, GmError m) => Cradle -> m CabalConfig
-cabalGetConfig = getConfig
-
-- | Get list of 'Package's needed by all components of the current package
-cabalConfigDependencies :: CabalConfig -> PackageIdentifier -> [Package]
-cabalConfigDependencies config thisPkg =
-    configDependencies thisPkg config
-
-
-- | Get the flag assignment from the local build info of the given cradle
-cabalConfigFlags :: (IOish m, GmError m) => CabalConfig -> m FlagAssignment
-cabalConfigFlags config = do
-  case configFlags config of
-    Right x  -> return x
-    Left msg -> throwError (GMECabalFlags (GMEString msg))
--- a/Language/Haskell/GhcMod/CabalConfig/Cabal16.hs
+++ b/Language/Haskell/GhcMod/CabalConfig/Cabal16.hs
@ -1,45 +0,0 @@
-- Copyright   :  Isaac Jones 2003-2004
-{- All rights reserved.
-
-Redistribution and use in source and binary forms, with or without
-modification, are permitted provided that the following conditions are
-met:
-
-    * Redistributions of source code must retain the above copyright
-      notice, this list of conditions and the following disclaimer.
-
-    * Redistributions in binary form must reproduce the above
-      copyright notice, this list of conditions and the following
-      disclaimer in the documentation and/or other materials provided
-      with the distribution.
-
-    * Neither the name of Isaac Jones nor the names of other
-      contributors may be used to endorse or promote products derived
-      from this software without specific prior written permission.
-
-THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
-"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
-LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
-A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
-OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
-SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
-LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
-DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
-THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
-(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
-OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -}
-
-
-- | ComponentLocalBuildInfo for Cabal <= 1.16
-module Language.Haskell.GhcMod.CabalConfig.Cabal16 (
-    ComponentLocalBuildInfo
-  , componentPackageDeps
-  ) where
-
-import Distribution.Package (InstalledPackageId, PackageIdentifier)
-
-- From Cabal <= 1.16
-data ComponentLocalBuildInfo = ComponentLocalBuildInfo {
-    componentPackageDeps :: [(InstalledPackageId, PackageIdentifier)]
-  }
-  deriving (Read, Show)
--- a/Language/Haskell/GhcMod/CabalConfig/Cabal18.hs
+++ b/Language/Haskell/GhcMod/CabalConfig/Cabal18.hs
@ -1,58 +0,0 @@
-- Copyright   :  Isaac Jones 2003-2004
-{- All rights reserved.
-
-Redistribution and use in source and binary forms, with or without
-modification, are permitted provided that the following conditions are
-met:
-
-    * Redistributions of source code must retain the above copyright
-      notice, this list of conditions and the following disclaimer.
-
-    * Redistributions in binary form must reproduce the above
-      copyright notice, this list of conditions and the following
-      disclaimer in the documentation and/or other materials provided
-      with the distribution.
-
-    * Neither the name of Isaac Jones nor the names of other
-      contributors may be used to endorse or promote products derived
-      from this software without specific prior written permission.
-
-THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
-"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
-LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
-A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
-OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
-SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
-LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
-DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
-THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
-(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
-OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -}
-
-- | ComponentLocalBuildInfo for Cabal >= 1.18
-module Language.Haskell.GhcMod.CabalConfig.Cabal18 (
-    ComponentLocalBuildInfo
-  , componentPackageDeps
-  , componentLibraries
-  ) where
-
-import Distribution.Package (InstalledPackageId, PackageId)
-
-data LibraryName = LibraryName String
-    deriving (Read, Show)
-
-data ComponentLocalBuildInfo
-  = LibComponentLocalBuildInfo {
-    componentPackageDeps :: [(InstalledPackageId, PackageId)],
-    componentLibraries :: [LibraryName]
-  }
-  | ExeComponentLocalBuildInfo {
-    componentPackageDeps :: [(InstalledPackageId, PackageId)]
-  }
-  | TestComponentLocalBuildInfo {
-    componentPackageDeps :: [(InstalledPackageId, PackageId)]
-  }
-  | BenchComponentLocalBuildInfo {
-    componentPackageDeps :: [(InstalledPackageId, PackageId)]
-  }
-  deriving (Read, Show)
--- a/Language/Haskell/GhcMod/CabalConfig/Cabal21.hs
+++ b/Language/Haskell/GhcMod/CabalConfig/Cabal21.hs
@ -1,73 +0,0 @@
-- Copyright   :  Isaac Jones 2003-2004
-{- All rights reserved.
-
-Redistribution and use in source and binary forms, with or without
-modification, are permitted provided that the following conditions are
-met:
-
-    * Redistributions of source code must retain the above copyright
-      notice, this list of conditions and the following disclaimer.
-
-    * Redistributions in binary form must reproduce the above
-      copyright notice, this list of conditions and the following
-      disclaimer in the documentation and/or other materials provided
-      with the distribution.
-
-    * Neither the name of Isaac Jones nor the names of other
-      contributors may be used to endorse or promote products derived
-      from this software without specific prior written permission.
-
-THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
-"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
-LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
-A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
-OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
-SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
-LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
-DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
-THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
-(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
-OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -}
-
-- | ComponentLocalBuildInfo for Cabal >= 1.21
-module Language.Haskell.GhcMod.CabalConfig.Cabal21 (
-    ComponentLocalBuildInfo
-  , PackageIdentifier(..)
-  , PackageName(..)
-  , componentPackageDeps
-  , componentLibraries
-  ) where
-
-import Distribution.Package (InstalledPackageId)
-import Data.Version (Version)
-
-data LibraryName = LibraryName String
-    deriving (Read, Show)
-
-newtype PackageName = PackageName { unPackageName :: String }
-  deriving (Read, Show)
-
-data PackageIdentifier
-  = PackageIdentifier {
-    pkgName :: PackageName,
-    pkgVersion :: Version
-  }
-  deriving (Read, Show)
-
-type PackageId = PackageIdentifier
-
-data ComponentLocalBuildInfo
-  = LibComponentLocalBuildInfo {
-    componentPackageDeps :: [(InstalledPackageId, PackageId)],
-    componentLibraries :: [LibraryName]
-  }
-  | ExeComponentLocalBuildInfo {
-    componentPackageDeps :: [(InstalledPackageId, PackageId)]
-  }
-  | TestComponentLocalBuildInfo {
-    componentPackageDeps :: [(InstalledPackageId, PackageId)]
-  }
-  | BenchComponentLocalBuildInfo {
-    componentPackageDeps :: [(InstalledPackageId, PackageId)]
-  }
-  deriving (Read, Show)
--- a/Language/Haskell/GhcMod/CabalConfig/Cabal22.hs
+++ b/Language/Haskell/GhcMod/CabalConfig/Cabal22.hs
@ -1,107 +0,0 @@
-{-# OPTIONS_GHC -fno-warn-unused-binds #-}
-- Copyright   :  Isaac Jones 2003-2004
-- Copyright   :  (c) The University of Glasgow 2004
-- Copyright   :  Duncan Coutts 2008
-{- All rights reserved.
-
-Redistribution and use in source and binary forms, with or without
-modification, are permitted provided that the following conditions are
-met:
-
-    * Redistributions of source code must retain the above copyright
-      notice, this list of conditions and the following disclaimer.
-
-    * Redistributions in binary form must reproduce the above
-      copyright notice, this list of conditions and the following
-      disclaimer in the documentation and/or other materials provided
-      with the distribution.
-
-    * Neither the name of Isaac Jones nor the names of other
-      contributors may be used to endorse or promote products derived
-      from this software without specific prior written permission.
-
-THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
-"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
-LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
-A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
-OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
-SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
-LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
-DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
-THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
-(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
-OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -}
-
-- | ComponentLocalBuildInfo for Cabal >= 1.22
-module Language.Haskell.GhcMod.CabalConfig.Cabal22 (
-    ComponentLocalBuildInfo
-  , PackageIdentifier(..)
-  , PackageName(..)
-  , componentPackageDeps
-  , componentLibraries
-  ) where
-
-import Distribution.Package (InstalledPackageId)
-import Data.Version (Version)
-import Data.Map (Map)
-
-data LibraryName = LibraryName String
-    deriving (Read, Show)
-
-newtype PackageName = PackageName { unPackageName :: String }
-  deriving (Read, Show, Ord, Eq)
-
-data PackageIdentifier
-  = PackageIdentifier {
-    pkgName :: PackageName,
-    pkgVersion :: Version
-  }
-  deriving (Read, Show)
-
-type PackageId = PackageIdentifier
-
-newtype ModuleName = ModuleName [String]
-  deriving (Read, Show)
-
-data ModuleRenaming = ModuleRenaming Bool [(ModuleName, ModuleName)]
-    deriving (Read, Show)
-
-data OriginalModule
-   = OriginalModule {
-       originalPackageId :: InstalledPackageId,
-       originalModuleName :: ModuleName
-     }
-  deriving (Read, Show)
-
-data ExposedModule
-   = ExposedModule {
-       exposedName      :: ModuleName,
-       exposedReexport  :: Maybe OriginalModule,
-       exposedSignature :: Maybe OriginalModule -- This field is unused for now.
-     }
-  deriving (Read, Show)
-
-data ComponentLocalBuildInfo
-  = LibComponentLocalBuildInfo {
-    -- | Resolved internal and external package dependencies for this component.
-    -- The 'BuildInfo' specifies a set of build dependencies that must be
-    -- satisfied in terms of version ranges. This field fixes those dependencies
-    -- to the specific versions available on this machine for this compiler.
-    componentPackageDeps :: [(InstalledPackageId, PackageId)],
-    componentExposedModules :: [ExposedModule],
-    componentPackageRenaming :: Map PackageName ModuleRenaming,
-    componentLibraries :: [LibraryName]
-  }
-  | ExeComponentLocalBuildInfo {
-    componentPackageDeps :: [(InstalledPackageId, PackageId)],
-    componentPackageRenaming :: Map PackageName ModuleRenaming
-  }
-  | TestComponentLocalBuildInfo {
-    componentPackageDeps :: [(InstalledPackageId, PackageId)],
-    componentPackageRenaming :: Map PackageName ModuleRenaming
-  }
-  | BenchComponentLocalBuildInfo {
-    componentPackageDeps :: [(InstalledPackageId, PackageId)],
-    componentPackageRenaming :: Map PackageName ModuleRenaming
-  }
-  deriving (Read, Show)
--- a/Language/Haskell/GhcMod/CabalConfig/Extract.hs
+++ b/Language/Haskell/GhcMod/CabalConfig/Extract.hs
@ -1,223 +0,0 @@
-{-# LANGUAGE RecordWildCards, CPP, OverloadedStrings #-}
-
-- | This module facilitates extracting information from Cabal's on-disk
-- 'LocalBuildInfo' (@dist/setup-config@).
-module Language.Haskell.GhcMod.CabalConfig.Extract (
-    CabalConfig
-  , configDependencies
-  , configFlags
-  , getConfig
-  ) where
-
-import Language.Haskell.GhcMod.Error
-import Language.Haskell.GhcMod.GhcPkg
-import Language.Haskell.GhcMod.PathsAndFiles
-import Language.Haskell.GhcMod.Read
-import Language.Haskell.GhcMod.Types
-import Language.Haskell.GhcMod.Utils
-import Language.Haskell.GhcMod.World
-
-import qualified Language.Haskell.GhcMod.CabalConfig.Cabal16 as C16
-import qualified Language.Haskell.GhcMod.CabalConfig.Cabal18 as C18
-import qualified Language.Haskell.GhcMod.CabalConfig.Cabal22 as C22
-
-#ifndef MIN_VERSION_mtl
-#define MIN_VERSION_mtl(x,y,z) 1
-#endif
-
-import Control.Applicative ((<$>))
-import Control.Monad (void, mplus, when)
-#if MIN_VERSION_mtl(2,2,1)
-import Control.Monad.Except ()
-#else
-import Control.Monad.Error ()
-#endif
-import Data.List (find,tails,isPrefixOf,isInfixOf,nub,stripPrefix)
-import Data.Version
-import Distribution.Package (InstalledPackageId(..)
-                           , PackageIdentifier(..)
-                           , PackageName(..))
-import Distribution.PackageDescription (FlagAssignment)
-import Distribution.Simple.LocalBuildInfo (ComponentName)
-import MonadUtils (liftIO)
-import Text.ParserCombinators.ReadP
-
-import Data.ByteString (ByteString)
-import qualified Data.ByteString as BS
-import qualified Data.ByteString.Char8 as BS8
-import qualified Data.Text as T
-import qualified Data.Text.Encoding as T
-
----------------------------------------------------------------
-
-- | 'Show'ed cabal 'LocalBuildInfo' string
-newtype CabalConfig = CabalConfig { unCabalConfig :: String }
-
-- | Get contents of the file containing 'LocalBuildInfo' data. If it doesn't
-- exist run @cabal configure@ i.e. configure with default options like @cabal
-- build@ would do.
-getConfig :: (IOish m, GmError m) => Cradle -> m CabalConfig
-getConfig crdl = do
-    liftIO (getCurrentWorld crdl) >>= \world ->
-        when (isSetupConfigOutOfDate world) configure
-
-    cfg <- liftIO (BS.readFile file) `tryFix` \_ ->
-             configure `modifyError'` GMECabalConfigure
-
-    liftIO (getCurrentWorld crdl) >>= \world ->
-        decodeConfig crdl world file cfg
- where
-   file = setupConfigFile crdl
-   prjDir = cradleRootDir crdl
-
-   configure :: (IOish m, GmError m) => m ()
-   configure = withDirectory_ prjDir $ void $ readProcess' "cabal" ["configure"]
-
-decodeConfig :: (IOish m, GmError m)
-             => Cradle -> World -> FilePath -> ByteString -> m CabalConfig
-decodeConfig _crdl _world file bs = CabalConfig <$> gen
-
--  if cacheOutdated world
--     then
--       gmLog $ "Regenerating pretty setup-config cache: " ++ prettyConfigCache
--       liftIO $ writeFile prettyConfigCache cfg
--     else CabalConfig <$> liftIO (readFile prettyConfigCache)
-
- where
-   -- cacheOutdated World {..} =
-   --     case (worldCabalConfig, worldPrettyCabalConfigCache) of
-   --       (Nothing, _) -> error "decodeConfig: setup-config does not exist."
-   --       (Just _, Nothing) -> True
-   --       (Just s, Just p) -> s > p
-
-   gen = case BS8.lines bs of
-           header:_ -> do
-               ((_,cabalVer), _) <- parseHeader header
-               if cabalVer >= (Version [1,22] [])
-                 then prettyPrintBinaryConfig file
-                 else return $ bsToStr bs
-           [] -> throwError $ GMECabalStateFile GMConfigStateFileNoHeader
-
-prettyPrintBinaryConfig :: (IOish m, GmError m)
-                             => String -> m String
-prettyPrintBinaryConfig file = do
-  exe <- liftIO $ findLibexecExe "ghc-mod-cabal"
-  slbi <- readProcess' exe ["print-setup-config", file]
-  return slbi
-
-parseHeader :: GmError m
-            => ByteString -> m ((ByteString, Version), (ByteString, Version))
-parseHeader header = case BS8.words header of
-  ["Saved", "package", "config", "for", _pkgId , "written", "by", cabalId, "using", compId] -> modifyError (\_ -> GMECabalStateFile GMConfigStateFileBadHeader) $ do
-          cabalId' <- parsePkgId cabalId
-          compId' <- parsePkgId  compId
-          return (cabalId', compId')
-
-  _ -> throwError $ GMECabalStateFile GMConfigStateFileNoHeader
-
-parsePkgId :: (Error e, MonadError e m) => ByteString -> m (ByteString, Version)
-parsePkgId bs =
-    case BS8.split '-' bs of
-      [pkg, vers] -> return (pkg, parseVer vers)
-      _ -> throwError noMsg
- where
-   parseVer vers =
-       let (ver,""):[] =
-               filter ((=="") . snd) $ readP_to_S parseVersion (bsToStr vers)
-       in ver
-
-bsToStr :: ByteString -> String
-bsToStr = T.unpack . T.decodeUtf8
-
-- strToBs :: String -> ByteString
-- strToBs = T.encodeUtf8 . T.pack
-
-- | Extract list of depencenies for all components from 'CabalConfig'
-configDependencies :: PackageIdentifier -> CabalConfig -> [Package]
-configDependencies thisPkg config = map fromInstalledPackageId deps
- where
-    deps :: [InstalledPackageId]
-    deps = case deps16 `mplus` deps18 `mplus` deps22 of
-        Right ps -> ps
-        Left msg -> error msg
-
-    -- True if this dependency is an internal one (depends on the library
-    -- defined in the same package).
-    internal pkgid = pkgid == thisPkg
-
-    -- Cabal >= 1.22
-    deps22 :: Either String [InstalledPackageId]
-    deps22 =
-        map fst
-      <$> filterInternal22
-      <$> (readEither =<< extractField (unCabalConfig config) "componentsConfigs")
-
-    filterInternal22
-        :: [(ComponentName, C22.ComponentLocalBuildInfo, [ComponentName])]
-        -> [(InstalledPackageId, C22.PackageIdentifier)]
-
-    filterInternal22 ccfg = [ (ipkgid, pkgid)
-                          | (_,clbi,_)      <- ccfg
-                          , (ipkgid, pkgid) <- C22.componentPackageDeps clbi
-                          , not (internal . packageIdentifierFrom22 $ pkgid) ]
-
-    packageIdentifierFrom22 :: C22.PackageIdentifier -> PackageIdentifier
-    packageIdentifierFrom22 (C22.PackageIdentifier (C22.PackageName myName) myVersion) =
-        PackageIdentifier (PackageName myName) myVersion
-
-    -- Cabal >= 1.18 && < 1.20
-    deps18 :: Either String [InstalledPackageId]
-    deps18 =
-          map fst
-      <$> filterInternal
-      <$> (readEither =<< extractField (unCabalConfig config) "componentsConfigs")
-
-    filterInternal
-        :: [(ComponentName, C18.ComponentLocalBuildInfo, [ComponentName])]
-        -> [(InstalledPackageId, PackageIdentifier)]
-
-    filterInternal ccfg = [ (ipkgid, pkgid)
-                          | (_,clbi,_)      <- ccfg
-                          , (ipkgid, pkgid) <- C18.componentPackageDeps clbi
-                          , not (internal pkgid) ]
-
-    -- Cabal 1.16 and below
-    deps16 :: Either String [InstalledPackageId]
-    deps16 = map fst <$> filter (not . internal . snd) . nub <$> do
-        cbi <- concat <$> sequence [ extract "executableConfigs"
-                                   , extract "testSuiteConfigs"
-                                   , extract "benchmarkConfigs" ]
-                        :: Either String [(String, C16.ComponentLocalBuildInfo)]
-
-        return $ maybe [] C16.componentPackageDeps libraryConfig
-              ++ concatMap (C16.componentPackageDeps . snd) cbi
-     where
-       libraryConfig :: Maybe C16.ComponentLocalBuildInfo
-       libraryConfig = do
-         field <- find ("libraryConfig" `isPrefixOf`) (tails $ unCabalConfig config)
-         clbi <- stripPrefix " = " field
-         if "Nothing" `isPrefixOf` clbi
-             then Nothing
-             else case readMaybe =<< stripPrefix "Just " clbi of
-                    Just x -> x
-                    Nothing -> error $ "reading libraryConfig failed\n" ++ show (stripPrefix "Just " clbi)
-
-       extract :: String -> Either String [(String, C16.ComponentLocalBuildInfo)]
-       extract field = readConfigs field <$> extractField (unCabalConfig config) field
-
-       readConfigs :: String -> String -> [(String, C16.ComponentLocalBuildInfo)]
-       readConfigs f s = case readEither s of
-           Right x -> x
-           Left msg -> error $ "reading config " ++ f ++ " failed ("++msg++")"
-
-- | Extract the cabal flags from the 'CabalConfig'
-configFlags :: CabalConfig -> Either String FlagAssignment
-configFlags (CabalConfig config) = readEither =<< flip extractField "configConfigurationsFlags" =<< extractField config "configFlags"
-
-- | Find @field@ in 'CabalConfig'. Returns 'Left' containing a user readable
-- error message with lots of context on failure.
-extractField :: String -> String -> Either String String
-extractField content field =
-    case extractParens <$> find (field `isPrefixOf`) (tails content) of
-        Just f -> Right f
-        Nothing -> Left $ "extractField: failed extracting "++field++" from input, input contained `"++field++"'? " ++ show (field `isInfixOf` content)
--- a/Language/Haskell/GhcMod/CabalConfig/Ghc710.hs
+++ b/Language/Haskell/GhcMod/CabalConfig/Ghc710.hs
@ -1,49 +0,0 @@
-module Language.Haskell.GhcMod.CabalConfig.Ghc710 (
-    configDependencies
-  , configFlags
-  , getConfig
-  ) where
-
-import Control.Monad
-import Distribution.Simple.LocalBuildInfo (LocalBuildInfo, externalPackageDeps)
-import qualified Distribution.Simple.LocalBuildInfo as LBI
-import Distribution.Simple.Configure (getConfigStateFile)
-import Distribution.Simple.Setup (configConfigurationsFlags)
-import Distribution.PackageDescription (FlagAssignment)
-
-import MonadUtils (liftIO)
-
-import Language.Haskell.GhcMod.Error
-import Language.Haskell.GhcMod.GhcPkg
-import Language.Haskell.GhcMod.PathsAndFiles
-import Language.Haskell.GhcMod.Types
-import Language.Haskell.GhcMod.Monad.Types
-import Language.Haskell.GhcMod.Utils
-import Language.Haskell.GhcMod.World
-
-
-- | Get contents of the file containing 'LocalBuildInfo' data. If it doesn't
-- exist run @cabal configure@ i.e. configure with default options like @cabal
-- build@ would do.
-getConfig :: (IOish m, GmError m)
-          => Cradle
-          -> m LocalBuildInfo
-getConfig cradle = liftIO (getCurrentWorld cradle) >>= \world -> do
-    when (isSetupConfigOutOfDate world) configure
-    liftIO (getConfigStateFile file) `tryFix` \_ ->
-        configure `modifyError'` GMECabalConfigure
- where
-   file = setupConfigFile cradle
-   prjDir = cradleRootDir cradle
-
-   configure :: (IOish m, GmError m) => m ()
-   configure = withDirectory_ prjDir $ void $ readProcess' "cabal" ["configure"]
-
-configDependencies :: a -> LocalBuildInfo -> [Package]
-configDependencies _ lbi =
-  [ fromInstalledPackageId instPkgId
-  | (instPkgId, _) <- externalPackageDeps lbi ]
-
-
-configFlags :: LocalBuildInfo -> Either String FlagAssignment
-configFlags = Right . configConfigurationsFlags . LBI.configFlags
--- a/Language/Haskell/GhcMod/CabalHelper.hs
+++ b/Language/Haskell/GhcMod/CabalHelper.hs
@ -0,0 +1,104 @@
+-- ghc-mod: Making Haskell development *more* fun
+-- Copyright (C) 2015  Daniel Gröber <dxld ÄT darkboxed DOT org>
+--
+-- This program is free software: you can redistribute it and/or modify
+-- it under the terms of the GNU Affero General Public License as published by
+-- the Free Software Foundation, either version 3 of the License, or
+-- (at your option) any later version.
+--
+-- This program is distributed in the hope that it will be useful,
+-- but WITHOUT ANY WARRANTY; without even the implied warranty of
+-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+-- GNU Affero General Public License for more details.
+--
+-- You should have received a copy of the GNU Affero General Public License
+-- along with this program.  If not, see <http://www.gnu.org/licenses/>.
+
+module Language.Haskell.GhcMod.CabalHelper (
+    CabalHelper(..)
+  , getComponents
+  , getGhcOptions
+  , getGhcPkgOptions
+  , cabalHelper
+  ) where
+
+import Control.Applicative
+import Control.Monad
+import Data.Monoid
+import Data.List
+import Language.Haskell.GhcMod.Types
+import Language.Haskell.GhcMod.Monad.Types
+import Language.Haskell.GhcMod.Error
+import Language.Haskell.GhcMod.Utils
+import Language.Haskell.GhcMod.World
+import Language.Haskell.GhcMod.PathsAndFiles
+import System.FilePath
+
+-- | Only package related GHC options, sufficient for things that don't need to
+-- access home modules
+getGhcPkgOptions :: (MonadIO m, GmEnv m) => m [(GmComponentName, [GHCOption])]
+getGhcPkgOptions = chGhcPkgOptions `liftM` cabalHelper
+
+getGhcOptions :: (MonadIO m, GmEnv m) => m [(GmComponentName, [GHCOption])]
+getGhcOptions = chGhcOptions `liftM` cabalHelper
+
+-- | Primary interface to cabal-helper and intended single entrypoint to
+-- constructing 'GmComponent's
+--
+-- The Component\'s 'gmcHomeModuleGraph' will be empty and has to be resolved by
+-- 'resolveGmComponents'.
+getComponents :: (MonadIO m, GmEnv m)
+    => m [GmComponent (Either FilePath [ModuleName])]
+getComponents = cabalHelper >>= \CabalHelper {..} -> return $ let
+  ([(scn, sep)], eps) = partition ((GmSetupHsName ==) . fst) chEntrypoints
+  sc = GmComponent scn [] [] sep sep ["."] mempty
+  cs = flip map (zip4 eps chGhcOptions chGhcSrcOptions chSourceDirs) $
+      \((cn, ep), (_, opts), (_, srcOpts), (_, srcDirs)) ->
+          GmComponent cn opts srcOpts ep ep srcDirs mempty
+  in sc:cs
+
+
+withCabal :: (MonadIO m, GmEnv m) => m a -> m a
+withCabal action = do
+    crdl <- cradle
+    Options { cabalProgram } <- options
+
+    liftIO $ whenM (isSetupConfigOutOfDate <$> getCurrentWorld crdl) $
+        withDirectory_ (cradleRootDir crdl) $
+            void $ readProcess cabalProgram ["configure"] ""
+
+    action
+
+data CabalHelper = CabalHelper {
+      chEntrypoints   :: [(GmComponentName, Either FilePath [ModuleName])],
+      chSourceDirs    :: [(GmComponentName, [String])],
+      chGhcOptions    :: [(GmComponentName, [String])],
+      chGhcSrcOptions :: [(GmComponentName, [String])],
+      chGhcPkgOptions :: [(GmComponentName, [String])]
+    } deriving (Show)
+
+cabalHelper :: (MonadIO m, GmEnv m) => m CabalHelper
+cabalHelper = withCabal $ do
+  let cmds = [ "entrypoints"
+             , "source-dirs"
+             , "ghc-options"
+             , "ghc-src-options"
+             , "ghc-pkg-options" ]
+
+  Cradle {..} <- cradle
+  exe <- liftIO $ findLibexecExe "cabal-helper-wrapper"
+
+  let distdir = cradleRootDir </> "dist"
+
+  res <- liftIO $ cached cradleRootDir (cabalHelperCache cmds) $ do
+           out <- readProcess exe (distdir:cmds) ""
+           evaluate (read out) `catch`
+               \(SomeException _) -> error "cabalHelper: read failed"
+
+  let [ Just (GmCabalHelperEntrypoints eps),
+        Just (GmCabalHelperStrings srcDirs),
+        Just (GmCabalHelperStrings ghcOpts),
+        Just (GmCabalHelperStrings ghcSrcOpts),
+        Just (GmCabalHelperStrings ghcPkgOpts) ] = res
+
+  return $ CabalHelper eps srcDirs ghcOpts ghcSrcOpts ghcPkgOpts
--- a/Language/Haskell/GhcMod/CaseSplit.hs
+++ b/Language/Haskell/GhcMod/CaseSplit.hs
@ -8,17 +8,24 @@ import Data.List (find, intercalate)
 import Data.Maybe (isJust)
 import qualified Data.Text as T
 import qualified Data.Text.IO as T (readFile)
+import System.FilePath
+
 import qualified DataCon as Ty
-import Exception (ghandle, SomeException(..))
 import GHC (GhcMonad, LPat, Id, ParsedModule(..), TypecheckedModule(..), DynFlags, SrcSpan, Type, GenLocated(L))
 import qualified GHC as G
-import Language.Haskell.GhcMod.Convert
-import qualified Language.Haskell.GhcMod.Gap as Gap
-import Language.Haskell.GhcMod.Monad
-import Language.Haskell.GhcMod.SrcUtils
 import Outputable (PprStyle)
 import qualified TyCon as Ty
 import qualified Type as Ty
+import Exception
+
+import Language.Haskell.GhcMod.Convert
+import Language.Haskell.GhcMod.DynFlags
+import qualified Language.Haskell.GhcMod.Gap as Gap
+import Language.Haskell.GhcMod.Monad
+import Language.Haskell.GhcMod.SrcUtils
+import Language.Haskell.GhcMod.Doc
+import Language.Haskell.GhcMod.Logging
+import Language.Haskell.GhcMod.Types

 ----------------------------------------------------------------
 -- CASE SPLITTING
@ -38,23 +45,29 @@ splits :: IOish m
       -> Int          -- ^ Line number.
       -> Int          -- ^ Column number.
       -> GhcModT m String
-splits file lineNo colNo = ghandle handler body
-  where
-    body = inModuleContext file $ \dflag style -> do
-        opt <- options
-        modSum <- Gap.fileModSummary file
-        whenFound' opt (getSrcSpanTypeForSplit modSum lineNo colNo) $ \x -> case x of
-          (SplitInfo varName bndLoc (varLoc,varT) _matches) -> do
-             let varName' = showName dflag style varName  -- Convert name to string
-             text <- genCaseSplitTextFile file (SplitToTextInfo varName' bndLoc varLoc $
-                                                getTyCons dflag style varName varT)
-             return (fourInts bndLoc, text)
-          (TySplitInfo varName bndLoc (varLoc,varT)) -> do
-             let varName' = showName dflag style varName  -- Convert name to string
-             text <- genCaseSplitTextFile file (SplitToTextInfo varName' bndLoc varLoc $
-                                                getTyCons dflag style varName varT)
-             return (fourInts bndLoc, text)
-    handler (SomeException _) = emptyResult =<< options
+splits file lineNo colNo =
+  runGmLoadedT' [Left file] deferErrors $ ghandle handler $ do
+      opt <- options
+      crdl <- cradle
+      style <- getStyle
+      dflag <- G.getSessionDynFlags
+      modSum <- Gap.fileModSummary (cradleCurrentDir crdl </> file)
+      whenFound' opt (getSrcSpanTypeForSplit modSum lineNo colNo) $ \x -> case x of
+        (SplitInfo varName bndLoc (varLoc,varT) _matches) -> do
+          let varName' = showName dflag style varName  -- Convert name to string
+          t <- genCaseSplitTextFile file (SplitToTextInfo varName' bndLoc varLoc $
+                                             getTyCons dflag style varName varT)
+          return (fourInts bndLoc, t)
+        (TySplitInfo varName bndLoc (varLoc,varT)) -> do
+          let varName' = showName dflag style varName  -- Convert name to string
+          t <- genCaseSplitTextFile file (SplitToTextInfo varName' bndLoc varLoc $
+                                             getTyCons dflag style varName varT)
+          return (fourInts bndLoc, t)
+ where
+   handler (SomeException ex) = do
+     gmLog GmDebug "splits" $
+           text "" $$ nest 4 (showDoc ex)
+     emptyResult =<< options

 ----------------------------------------------------------------
 -- a. Code for getting the information of the variable
@ -180,13 +193,13 @@ showFieldNames dflag style v (x:xs) = let fName = showName dflag style x

 genCaseSplitTextFile :: GhcMonad m => FilePath -> SplitToTextInfo -> m String
 genCaseSplitTextFile file info = liftIO $ do
-  text <- T.readFile file
-  return $ getCaseSplitText (T.lines text) info
+  t <- T.readFile file
+  return $ getCaseSplitText (T.lines t) info

 getCaseSplitText :: [T.Text] -> SplitToTextInfo -> String
-getCaseSplitText text (SplitToTextInfo { sVarName = sVN, sBindingSpan = sBS
+getCaseSplitText t (SplitToTextInfo { sVarName = sVN, sBindingSpan = sBS
                                       , sVarSpan = sVS, sTycons = sT })  =
-  let bindingText = getBindingText text sBS
+  let bindingText = getBindingText t sBS
      difference  = srcSpanDifference sBS sVS
      replaced    = map (replaceVarWithTyCon bindingText difference sVN) sT
      -- The newly generated bindings need to be indented to align with the
@ -195,9 +208,9 @@ getCaseSplitText text (SplitToTextInfo { sVarName = sVN, sBindingSpan = sBS
   in T.unpack $ T.intercalate (T.pack "\n") (concat replaced')

 getBindingText :: [T.Text] -> SrcSpan -> [T.Text]
-getBindingText text srcSpan =
+getBindingText t srcSpan =
  let Just (sl,sc,el,ec) = Gap.getSrcSpan srcSpan
-      lines_ = drop (sl - 1) $ take el text
+      lines_ = drop (sl - 1) $ take el t
   in if sl == el
      then -- only one line
           [T.drop (sc - 1) $ T.take ec $ head lines_]
@ -212,7 +225,7 @@ srcSpanDifference b v =
   in (vsl - bsl, vsc - bsc, vel - bsl, vec - bsc) -- assume variable in one line

 replaceVarWithTyCon :: [T.Text] -> (Int,Int,Int,Int) -> String -> String -> [T.Text]
-replaceVarWithTyCon text (vsl,vsc,_,vec) varname tycon =
+replaceVarWithTyCon t (vsl,vsc,_,vec) varname tycon =
  let tycon'      = if ' ' `elem` tycon || ':' `elem` tycon then "(" ++ tycon ++ ")" else tycon
      lengthDiff  = length tycon' - length varname
      tycon''     = T.pack $ if lengthDiff < 0 then tycon' ++ replicate (-lengthDiff) ' ' else tycon'
@ -222,7 +235,7 @@ replaceVarWithTyCon text (vsl,vsc,_,vec) varname tycon =
                          else if n == vsl
                               then T.take vsc line `T.append` tycon'' `T.append` T.drop vec line
                               else T.replicate spacesToAdd (T.pack " ") `T.append` line)
-              [0 ..] text
+              [0 ..] t

 indentBindingTo :: SrcSpan -> [T.Text] -> [T.Text]
 indentBindingTo bndLoc binds =
--- a/Language/Haskell/GhcMod/Check.hs
+++ b/Language/Haskell/GhcMod/Check.hs
@ -9,8 +9,7 @@ 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 (IOish, GhcModT)
-import Language.Haskell.GhcMod.Target (setTargetFiles)
+import Language.Haskell.GhcMod.Monad

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

@ -29,15 +28,12 @@ checkSyntax files = either id id <$> check files
 check :: IOish m
      => [FilePath]  -- ^ The target files.
      -> GhcModT m (Either String String)
-{-
-check fileNames = overrideGhcUserOptions $ \ghcOpts -> do
-  withLogger (setAllWarningFlags . setNoMaxRelevantBindings . Gap.setWarnTypedHoles . Gap.setDeferTypeErrors) $ do
-    _ <- G.setSessionDynFlags =<< addCmdOpts ghcOpts =<< G.getSessionDynFlags
-    setTargetFiles fileNames
-}
-check fileNames =
-  withLogger (setAllWarningFlags . setNoMaxRelevantBindings) $
-    setTargetFiles fileNames
+check files =
+    runGmLoadedTWith
+      (map Left files)
+      return
+      ((fmap fst <$>) . withLogger (setAllWarningFlags . setNoMaxRelevantBindings))
+      (return ())

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

@ -51,8 +47,10 @@ expandTemplate files = either id id <$> expand files
 ----------------------------------------------------------------

 -- | Expanding Haskell Template.
-expand :: IOish m
-       => [FilePath]  -- ^ The target files.
-       -> GhcModT m (Either String String)
-expand fileNames = withLogger (Gap.setDumpSplices . setNoWarningFlags) $
-    setTargetFiles fileNames
+expand :: IOish m => [FilePath] -> GhcModT m (Either String String)
+expand files =
+    runGmLoadedTWith
+      (map Left files)
+      return
+      ((fmap fst <$>) . withLogger (Gap.setDumpSplices . setNoWarningFlags))
+      (return ())
--- a/Language/Haskell/GhcMod/Convert.hs
+++ b/Language/Haskell/GhcMod/Convert.hs
@ -2,7 +2,7 @@

 module Language.Haskell.GhcMod.Convert (convert, convert', emptyResult, whenFound, whenFound') where

-import Language.Haskell.GhcMod.Monad
+import Language.Haskell.GhcMod.Monad.Types
 import Language.Haskell.GhcMod.Types

 import Control.Applicative ((<$>))
@ -23,7 +23,7 @@ inter :: Char -> [Builder] -> Builder
 inter _ [] = id
 inter c bs = foldr1 (\x y -> x . (c:) . y) bs

-convert' :: (ToString a, IOish m) => a -> GhcModT m String
+convert' :: (ToString a, IOish m, GmEnv m) => a -> m String
 convert' x = flip convert x <$> options

 convert :: ToString a => Options -> a -> String
--- a/Language/Haskell/GhcMod/Cradle.hs
+++ b/Language/Haskell/GhcMod/Cradle.hs
@ -1,19 +1,21 @@
 module Language.Haskell.GhcMod.Cradle (
    findCradle
  , findCradle'
-  , findCradleWithoutSandbox
+  , findSpecCradle
  , cleanupCradle
  ) where

-import Language.Haskell.GhcMod.GhcPkg
 import Language.Haskell.GhcMod.PathsAndFiles
+import Language.Haskell.GhcMod.Monad.Types
 import Language.Haskell.GhcMod.Types
 import Language.Haskell.GhcMod.Utils

-import Control.Exception.IOChoice ((||>))
-import System.Directory (getCurrentDirectory, removeDirectoryRecursive)
-import System.FilePath (takeDirectory)
-
+import Control.Applicative
+import Control.Monad
+import Control.Monad.Trans.Maybe
+import Data.Maybe
+import System.Directory
+import System.FilePath

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

@ -25,51 +27,71 @@ findCradle :: IO Cradle
 findCradle = findCradle' =<< getCurrentDirectory

 findCradle' :: FilePath -> IO Cradle
-findCradle' dir = cabalCradle dir ||> sandboxCradle dir ||> plainCradle dir
+findCradle' dir = run $ do
+    (cabalCradle dir `mplus`  sandboxCradle dir `mplus` plainCradle dir)
+ where run a = fillTempDir =<< (fromJust <$> runMaybeT a)
+
+findSpecCradle :: FilePath -> IO Cradle
+findSpecCradle dir = do
+    let cfs = [cabalCradle, sandboxCradle]
+    cs <- catMaybes <$> mapM (runMaybeT . ($ dir)) cfs
+    gcs <- filterM isNotGmCradle cs
+    fillTempDir =<< case gcs of
+                      [] -> fromJust <$> runMaybeT (plainCradle dir)
+                      c:_ -> return c
+ where
+   isNotGmCradle :: Cradle -> IO Bool
+   isNotGmCradle crdl = do
+     not <$> doesFileExist (cradleRootDir crdl </> "ghc-mod.cabal")

 cleanupCradle :: Cradle -> IO ()
 cleanupCradle crdl = removeDirectoryRecursive $ cradleTempDir crdl

-cabalCradle :: FilePath -> IO Cradle
+fillTempDir :: MonadIO m => Cradle -> m Cradle
+fillTempDir crdl = do
+  tmpDir <- liftIO $ newTempDir (cradleRootDir crdl)
+  return crdl { cradleTempDir = tmpDir }
+
+cabalCradle :: FilePath -> MaybeT IO Cradle
 cabalCradle wdir = do
-    Just cabalFile <- findCabalFile wdir
+    cabalFile <- MaybeT $ findCabalFile wdir
+
    let cabalDir = takeDirectory cabalFile
-    pkgDbStack <- getPackageDbStack cabalDir
-    tmpDir <- newTempDir cabalDir
+    pkgDbStack <- liftIO $ getPackageDbStack cabalDir
+
    return Cradle {
        cradleCurrentDir = wdir
      , cradleRootDir    = cabalDir
-      , cradleTempDir    = tmpDir
+      , cradleTempDir    = error "tmpDir"
      , cradleCabalFile  = Just cabalFile
      , cradlePkgDbStack = pkgDbStack
      }

-sandboxCradle :: FilePath -> IO Cradle
+sandboxCradle :: FilePath -> MaybeT IO Cradle
 sandboxCradle wdir = do
-    Just sbDir <- findCabalSandboxDir wdir
-    pkgDbStack <- getPackageDbStack sbDir
-    tmpDir <- newTempDir sbDir
+    sbDir <- MaybeT $ findCabalSandboxDir wdir
+    pkgDbStack <- liftIO $ getPackageDbStack sbDir
    return Cradle {
        cradleCurrentDir = wdir
      , cradleRootDir    = sbDir
-      , cradleTempDir    = tmpDir
+      , cradleTempDir    = error "tmpDir"
      , cradleCabalFile  = Nothing
      , cradlePkgDbStack = pkgDbStack
      }

-plainCradle :: FilePath -> IO Cradle
+plainCradle :: FilePath -> MaybeT IO Cradle
 plainCradle wdir = do
-    tmpDir <- newTempDir wdir
-    return Cradle {
+    return $ Cradle {
        cradleCurrentDir = wdir
      , cradleRootDir    = wdir
-      , cradleTempDir    = tmpDir
+      , cradleTempDir    = error "tmpDir"
      , cradleCabalFile  = Nothing
      , cradlePkgDbStack = [GlobalDb, UserDb]
      }

-- Just for testing
-findCradleWithoutSandbox :: IO Cradle
-findCradleWithoutSandbox = do
-    cradle <- findCradle
-    return cradle { cradlePkgDbStack = [GlobalDb]} -- FIXME
+getPackageDbStack :: FilePath -- ^ Project Directory (where the
+                                 -- cabal.sandbox.config file would be if it
+                                 -- exists)
+                  -> IO [GhcPkgDb]
+getPackageDbStack cdir =
+    ([GlobalDb] ++) . maybe [UserDb] return <$> getSandboxDb cdir
--- a/Language/Haskell/GhcMod/Debug.hs
+++ b/Language/Haskell/GhcMod/Debug.hs
@ -1,41 +1,76 @@
 module Language.Haskell.GhcMod.Debug (debugInfo, rootInfo) where

+import Control.Arrow (first)
 import Control.Applicative ((<$>))
-import Data.List (intercalate)
-import Data.Maybe (isJust, fromJust)
+import qualified Data.Map as Map
+import qualified Data.Set as Set
+import Text.PrettyPrint
 import Language.Haskell.GhcMod.Convert
 import Language.Haskell.GhcMod.Monad
 import Language.Haskell.GhcMod.Types
-import Language.Haskell.GhcMod.CabalConfig
 import Language.Haskell.GhcMod.Internal
+import Language.Haskell.GhcMod.CabalHelper
+import Language.Haskell.GhcMod.Target
+import Language.Haskell.GhcMod.Pretty

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

 -- | Obtaining debug information.
 debugInfo :: IOish m => GhcModT m String
-debugInfo = cradle >>= \c -> convert' =<< do
-    CompilerOptions gopts incDir pkgs <-
-        if isJust $ cradleCabalFile c then
-            fromCabalFile c ||> simpleCompilerOption
-          else
-            simpleCompilerOption
-    return [
-        "Root directory:      " ++ cradleRootDir c
-      , "Current directory:   " ++ cradleCurrentDir c
-      , "Cabal file:          " ++ show (cradleCabalFile c)
-      , "GHC options:         " ++ unwords gopts
-      , "Include directories: " ++ unwords incDir
-      , "Dependent packages:  " ++ intercalate ", " (map showPkg pkgs)
-      , "System libraries:    " ++ ghcLibDir
-      ]
-  where
-    simpleCompilerOption = options >>= \op ->
-        return $ CompilerOptions (ghcUserOptions op) [] []
-    fromCabalFile crdl = options >>= \opts -> do
-        config <- cabalGetConfig crdl
-        pkgDesc <- parseCabalFile config $ fromJust $ cradleCabalFile crdl
-        getCompilerOptions (ghcUserOptions opts) crdl config pkgDesc
+debugInfo = do
+    Options {..} <- options
+    Cradle {..} <- cradle

+    cabal <-
+        case cradleCabalFile of
+          Just _ -> cabalDebug
+          Nothing -> return []
+
+    return $ unlines $
+      [ "Root directory:       " ++ cradleRootDir
+      , "Current directory:    " ++ cradleCurrentDir
+      , "GHC System libraries: " ++ ghcLibDir
+      , "GHC user options:     " ++ render (fsep $ map text ghcUserOptions)
+      ] ++ cabal
+
+cabalDebug :: IOish m => GhcModT m [String]
+cabalDebug = do
+    Cradle {..} <- cradle
+    mcs <- resolveGmComponents Nothing =<< getComponents
+    let entrypoints = Map.map gmcEntrypoints mcs
+        graphs      = Map.map gmcHomeModuleGraph mcs
+        opts        = Map.map gmcGhcOpts mcs
+        srcOpts     = Map.map gmcGhcSrcOpts mcs
+
+    return $
+         [ "Cabal file:           " ++ show cradleCabalFile
+         , "Cabal entrypoints:\n"       ++ render (nest 4 $
+              mapDoc gmComponentNameDoc smpDoc entrypoints)
+         , "Cabal components:\n"        ++ render (nest 4 $
+              mapDoc gmComponentNameDoc graphDoc graphs)
+         , "GHC Cabal options:\n"       ++ render (nest 4 $
+              mapDoc gmComponentNameDoc (fsep . map text) opts)
+         , "GHC search path options:\n" ++ render (nest 4 $
+              mapDoc gmComponentNameDoc (fsep . map text) srcOpts)
+         ]
+
+graphDoc :: GmModuleGraph -> Doc
+graphDoc GmModuleGraph{..} =
+    mapDoc mpDoc' smpDoc' gmgGraph
+ where
+   smpDoc' smp = vcat $ map mpDoc' $ Set.toList smp
+   mpDoc' = text . moduleNameString . mpModule
+
+smpDoc :: Set.Set ModulePath -> Doc
+smpDoc smp = vcat $ map mpDoc $ Set.toList smp
+
+mpDoc :: ModulePath -> Doc
+mpDoc (ModulePath mn fn) = text (moduleNameString mn) <+> parens (text fn)
+
+
+mapDoc :: (k -> Doc) -> (a -> Doc) -> Map.Map k a -> Doc
+mapDoc kd ad m = vcat $
+    map (uncurry ($+$)) $ map (first kd) $ Map.toList $ Map.map (nest 4 . ad) m
 ----------------------------------------------------------------

 -- | Obtaining root information.
--- a/Language/Haskell/GhcMod/Doc.hs
+++ b/Language/Haskell/GhcMod/Doc.hs
@ -1,9 +1,8 @@
 module Language.Haskell.GhcMod.Doc where

-import GHC (DynFlags, GhcMonad)
-import qualified GHC as G
+import GHC
 import Language.Haskell.GhcMod.Gap (withStyle, showDocWith)
-import Outputable (SDoc, PprStyle, mkUserStyle, Depth(AllTheWay), neverQualify)
+import Outputable
 import Pretty (Mode(..))

 showPage :: DynFlags -> PprStyle -> SDoc -> String
@ -12,9 +11,14 @@ showPage dflag style = showDocWith dflag PageMode . withStyle dflag style
 showOneLine :: DynFlags -> PprStyle -> SDoc -> String
 showOneLine dflag style = showDocWith dflag OneLineMode . withStyle dflag style

+showForUser :: DynFlags -> PrintUnqualified -> SDoc -> String
+showForUser dflags unqual sdoc =
+    showDocWith dflags PageMode $
+      runSDoc sdoc $ initSDocContext dflags $ mkUserStyle unqual AllTheWay
+
 getStyle :: GhcMonad m => m PprStyle
 getStyle = do
-    unqual <- G.getPrintUnqual
+    unqual <- getPrintUnqual
    return $ mkUserStyle unqual AllTheWay

 styleUnqualified :: PprStyle
--- a/Language/Haskell/GhcMod/DynFlags.hs
+++ b/Language/Haskell/GhcMod/DynFlags.hs
@ -12,8 +12,6 @@ import qualified Language.Haskell.GhcMod.Gap as Gap
 import Language.Haskell.GhcMod.Types
 import System.IO.Unsafe (unsafePerformIO)

-data Build = CabalPkg | SingleFile deriving Eq
-
 setEmptyLogger :: DynFlags -> DynFlags
 setEmptyLogger df = Gap.setLogAction df $ \_ _ _ _ _ -> return ()

@ -41,37 +39,15 @@ setModeIntelligent df = df {
  , optLevel  = 0
  }

-setIncludeDirs :: [IncludeDir] -> DynFlags -> DynFlags
-setIncludeDirs idirs df = df { importPaths = idirs }
-
-setBuildEnv :: Build -> DynFlags -> DynFlags
-setBuildEnv build = setHideAllPackages build . setCabalPackage build
-
-- | With ghc-7.8 this option simply makes GHC print a message suggesting users
-- add hiddend packages to the build-depends field in their cabal file when the
-- user tries to import a module form a hidden package.
-setCabalPackage :: Build -> DynFlags -> DynFlags
-setCabalPackage CabalPkg df = Gap.setCabalPkg df
-setCabalPackage _ df = df
-
-- | Enable hiding of all package not explicitly exposed (like Cabal does)
-setHideAllPackages :: Build -> DynFlags -> DynFlags
-setHideAllPackages CabalPkg df = Gap.setHideAllPackages df
-setHideAllPackages _ df = df
-
 -- | Parse command line ghc options and add them to the 'DynFlags' passed
 addCmdOpts :: GhcMonad m => [GHCOption] -> DynFlags -> m DynFlags
 addCmdOpts cmdOpts df =
-    tfst <$> G.parseDynamicFlags df (map G.noLoc cmdOpts)
+    fst3 <$> G.parseDynamicFlags df (map G.noLoc cmdOpts)
  where
-    tfst (a,_,_) = a
+    fst3 (a,_,_) = a

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

-- | Return the 'DynFlags' currently in use in the GHC session.
-getDynamicFlags :: IO DynFlags
-getDynamicFlags = G.runGhc (Just libdir) G.getSessionDynFlags
-
 withDynFlags :: GhcMonad m
             => (DynFlags -> DynFlags)
             -> m a
@ -119,3 +95,7 @@ setNoMaxRelevantBindings df = df { maxRelevantBinds = Nothing }
 #else
 setNoMaxRelevantBindings = id
 #endif
+
+deferErrors :: DynFlags -> Ghc DynFlags
+deferErrors df = return $
+  Gap.setWarnTypedHoles $ Gap.setDeferTypeErrors $ setNoWarningFlags df
--- a/Language/Haskell/GhcMod/Error.hs
+++ b/Language/Haskell/GhcMod/Error.hs
@ -1,4 +1,3 @@
-{-# LANGUAGE TypeFamilies, ScopedTypeVariables, DeriveDataTypeable #-}
 -- ghc-mod: Making Haskell development *more* fun
 -- Copyright (C) 2015  Daniel Gröber <dxld ÄT darkboxed DOT org>
 --
@ -14,64 +13,47 @@
 --
 -- You should have received a copy of the GNU Affero General Public License
 -- along with this program.  If not, see <http://www.gnu.org/licenses/>.
+
+{-# LANGUAGE ExistentialQuantification #-}
 module Language.Haskell.GhcMod.Error (
    GhcModError(..)
  , GMConfigStateFileError(..)
  , GmError
  , gmeDoc
+  , ghcExceptionDoc
+  , liftMaybe
+  , overrideError
  , modifyError
  , modifyError'
+  , modifyGmError
  , tryFix
+  , GHandler(..)
+  , gcatches
  , module Control.Monad.Error
-  , module Exception
+  , module Control.Exception
  ) where

-import Control.Monad.Error (MonadError(..), Error(..))
+import Control.Arrow
+import Control.Exception
+import Control.Monad.Error
+import qualified Data.Set as Set
 import Data.List
-import Data.Typeable
-import Exception
+import Data.Version
+import System.Process (showCommandForUser)
 import Text.PrettyPrint
+import Text.Printf
+
+import Exception
+import Panic
+import Config (cProjectVersion, cHostPlatformString)
+import Paths_ghc_mod (version)
+
+import Language.Haskell.GhcMod.Types
+import Language.Haskell.GhcMod.Pretty
+

 type GmError m = MonadError GhcModError m

-data GhcModError = GMENoMsg
-                 -- ^ Unknown error
-
-                 | GMEString String
-                 -- ^ Some Error with a message. These are produced mostly by
-                 -- 'fail' calls on GhcModT.
-
-                 | GMEIOException IOException
-                 -- ^ IOExceptions captured by GhcModT's MonadIO instance
-
-                 | GMECabalConfigure GhcModError
-                 -- ^ Configuring a cabal project failed.
-
-                 | GMECabalFlags GhcModError
-                 -- ^ Retrieval of the cabal configuration flags failed.
-
-                 | GMEProcess [String] GhcModError
-                 -- ^ Launching an operating system process failed. The first
-                 -- field is the command.
-
-                 | GMENoCabalFile
-                 -- ^ No cabal file found.
-
-                 | GMETooManyCabalFiles [FilePath]
-                 -- ^ Too many cabal files found.
-
-                 | GMECabalStateFile GMConfigStateFileError
-                 -- ^ Reading Cabal's state configuration file falied somehow.
-                   deriving (Eq,Show,Typeable)
-
-data GMConfigStateFileError
-    = GMConfigStateFileNoHeader
-    | GMConfigStateFileBadHeader
-    | GMConfigStateFileNoParse
-    | GMConfigStateFileMissing
--    | GMConfigStateFileBadVersion PackageIdentifier PackageIdentifier (Either ConfigStateFileError LocalBuildInfo)
-  deriving (Eq, Show, Read, Typeable)
-
 gmCsfeDoc :: GMConfigStateFileError -> Doc
 gmCsfeDoc GMConfigStateFileNoHeader = text $
        "Saved package config file header is missing. "
@ -103,31 +85,45 @@ gmCsfeDoc GMConfigStateFileMissing = text $
 --               ++ display currentCompilerId
 --               ++ ") which is probably the cause of the problem."

-
-
-
-
-instance Exception GhcModError
-
-instance Error GhcModError where
-    noMsg = GMENoMsg
-    strMsg = GMEString
-
 gmeDoc :: GhcModError -> Doc
 gmeDoc e = case e of
    GMENoMsg ->
        text "Unknown error"
    GMEString msg ->
        text msg
-    GMEIOException ioe ->
-        text $ show ioe
    GMECabalConfigure msg ->
-        text "cabal configure failed: " <> gmeDoc msg
+        text "Configuring cabal project failed: " <> gmeDoc msg
    GMECabalFlags msg ->
-        text "retrieval of the cabal configuration flags failed: " <> gmeDoc msg
-    GMEProcess cmd msg ->
-        text ("launching operating system process `"++unwords cmd++"` failed: ")
-          <> gmeDoc msg
+        text "Retrieval of the cabal configuration flags failed: " <> gmeDoc msg
+    GMECabalComponent cn ->
+        text "Cabal component " <> quotes (gmComponentNameDoc cn)
+                                <> text " could not be found."
+    GMECabalCompAssignment ctx ->
+        text "Could not find a consistent component assignment for modules:" $$
+          (nest 4 $ foldr ($+$) empty $ map ctxDoc ctx) $$
+        empty $$
+        text "Try this and that"
+
+      where
+        ctxDoc = moduleDoc *** compsDoc
+                 >>> first (<> colon) >>> uncurry (flip hang 4)
+
+        moduleDoc (Left fn)   =
+            text "File " <> quotes (text fn)
+        moduleDoc (Right mdl) =
+            text "Module " <> quotes (text $ moduleNameString mdl)
+
+        compsDoc sc | Set.null sc = text "has no known components"
+        compsDoc sc = fsep $ punctuate comma $
+                        map gmComponentNameDoc $ Set.toList sc
+
+    GMEProcess cmd args emsg -> let c = showCommandForUser cmd args in
+        case emsg of
+          Right err ->
+             text (printf "Launching system command `%s` failed: " c)
+                  <> gmeDoc err
+          Left (_out, _err, rv) -> text $
+             printf "Launching system command `%s` failed (exited with %d)" c rv
    GMENoCabalFile ->
        text "No cabal file found."
    GMETooManyCabalFiles cfs ->
@ -136,6 +132,32 @@ gmeDoc e = case e of
    GMECabalStateFile csfe ->
        gmCsfeDoc csfe

+ghcExceptionDoc :: GhcException -> Doc
+ghcExceptionDoc e@(CmdLineError _) =
+    text $ "<command line>: " ++ showGhcException e ""
+ghcExceptionDoc (UsageError str) = strDoc str
+ghcExceptionDoc (Panic msg) = vcat $ map text $ lines $ printf "\
+\GHC panic! (the 'impossible' happened)\n\
+\  ghc-mod version %s\n\
+\  GHC library version %s for %s:\n\
+\       %s\n\
+\\n\
+\Please report this as a bug: %s\n"
+    gmVer ghcVer platform msg url
+ where
+   gmVer = showVersion version
+   ghcVer = cProjectVersion
+   platform = cHostPlatformString
+   url = "https://github.com/kazu-yamamoto/ghc-mod/issues" :: String
+
+ghcExceptionDoc e = text $ showGhcException e ""
+
+
+liftMaybe :: MonadError e m => e -> m (Maybe a) -> m a
+liftMaybe e action = maybe (throwError e) return =<< action
+
+overrideError :: MonadError e m => e -> m a -> m a
+overrideError e action = modifyError (const e) action

 modifyError :: MonadError e m => (e -> e) -> m a -> m a
 modifyError f action = action `catchError` \e -> throwError $ f e
@ -144,6 +166,23 @@ infixr 0 `modifyError'`
 modifyError' :: MonadError e m => m a -> (e -> e) -> m a
 modifyError' = flip modifyError

+
+modifyGmError :: (MonadIO m, ExceptionMonad m)
+              => (GhcModError -> GhcModError) -> m a -> m a
+modifyGmError f a = gcatch a $ \(ex :: GhcModError) -> liftIO $ throwIO (f ex)
+
 tryFix :: MonadError e m => m a -> (e -> m ()) -> m a
-tryFix action fix = do
-  action `catchError` \e -> fix e >> action
+tryFix action f = do
+  action `catchError` \e -> f e >> action
+
+data GHandler m a = forall e . Exception e => GHandler (e -> m a)
+
+gcatches :: ExceptionMonad m => m a -> [GHandler m a] -> m a
+gcatches io handlers = io `gcatch` gcatchesHandler handlers
+
+gcatchesHandler :: ExceptionMonad m => [GHandler m a] -> SomeException -> m a
+gcatchesHandler handlers e = foldr tryHandler (liftIO $ throw e) handlers
+    where tryHandler (GHandler handler) res
+              = case fromException e of
+                Just e' -> handler e'
+                Nothing -> res
--- a/Language/Haskell/GhcMod/FillSig.hs
+++ b/Language/Haskell/GhcMod/FillSig.hs
@ -19,8 +19,10 @@ import qualified GHC as G
 import qualified Name as G
 import qualified Language.Haskell.GhcMod.Gap as Gap
 import Language.Haskell.GhcMod.Convert
+import Language.Haskell.GhcMod.DynFlags
 import Language.Haskell.GhcMod.Monad
 import Language.Haskell.GhcMod.SrcUtils
+import Language.Haskell.GhcMod.Doc
 import Language.Haskell.GhcMod.Types
 import Outputable (PprStyle)
 import qualified Type as Ty
@ -66,21 +68,29 @@ sig :: IOish m
    -> Int          -- ^ Line number.
    -> Int          -- ^ Column number.
    -> GhcModT m String
-sig file lineNo colNo = ghandle handler body
-  where
-    body = inModuleContext file $ \dflag style -> do
-        opt <- options
-        modSum <- Gap.fileModSummary file
-        whenFound opt (getSignature modSum lineNo colNo) $ \s -> case s of
+sig file lineNo colNo =
+    runGmLoadedT' [Left file] deferErrors $ ghandle handler $ do
+      opt <- options
+      style <- getStyle
+      dflag <- G.getSessionDynFlags
+      modSum <- Gap.fileModSummary file
+      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 ->
-             ("instance", fourInts loc, map (\x -> initialBody dflag style (G.idType x) x)
-                                            (Ty.classMethods cls))
+              ("function", fourInts loc, map (initialBody dflag style ty) names)
+
+          InstanceDecl loc cls -> let
+                body x = initialBody dflag style (G.idType x) x
+            in
+              ("instance", fourInts loc, body `map` Ty.classMethods cls)
+
          TyFamDecl loc name flavour vars ->
            let (rTy, initial) = initialTyFamString flavour
-             in (rTy, fourInts loc, [initial ++ initialFamBody dflag style name vars])
+                body = initialFamBody dflag style name vars
+             in (rTy, fourInts loc, [initial ++ body])

+
+  where
    handler (SomeException _) = do
      opt <- options
      -- Code cannot be parsed by ghc module
@ -321,10 +331,11 @@ refine :: IOish m
       -> Int          -- ^ Column number.
       -> Expression   -- ^ A Haskell expression.
       -> GhcModT m String
-refine file lineNo colNo expr = ghandle handler body
-  where
-    body = inModuleContext file $ \dflag style -> do
+refine file lineNo colNo expr =
+  runGmLoadedT' [Left file] deferErrors $ ghandle handler $ do
        opt <- options
+        style <- getStyle
+        dflag <- G.getSessionDynFlags
        modSum <- Gap.fileModSummary file
        p <- G.parseModule modSum
        tcm@TypecheckedModule{tm_typechecked_source = tcs} <- G.typecheckModule p
@ -339,7 +350,8 @@ refine file lineNo colNo expr = ghandle handler body
                  text = initialHead1 expr iArgs (infinitePrefixSupply name)
               in (fourInts loc, doParen paren text)

-    handler (SomeException _) = emptyResult =<< options
+ where
+   handler (SomeException _) = emptyResult =<< options

 -- Look for the variable in the specified position
 findVar :: GhcMonad m => DynFlags -> PprStyle
@ -386,10 +398,11 @@ auto :: IOish m
     -> Int          -- ^ Line number.
     -> Int          -- ^ Column number.
     -> GhcModT m String
-auto file lineNo colNo = ghandle handler body
-  where
-    body = inModuleContext file $ \dflag style -> do
+auto file lineNo colNo =
+  runGmLoadedT' [Left file] deferErrors $ ghandle handler $ do
        opt <- options
+        style <- getStyle
+        dflag <- G.getSessionDynFlags
        modSum <- Gap.fileModSummary file
        p <- G.parseModule modSum
        tcm@TypecheckedModule {
@ -415,8 +428,8 @@ auto file lineNo colNo = ghandle handler body
          djinns <- djinn True (Just minfo) env rty (Max 10) 100000
          return ( fourInts loc
                 , map (doParen paren) $ nub (djinnsEmpty ++ djinns))
-
-    handler (SomeException _) = emptyResult =<< options
+ where
+   handler (SomeException _) = emptyResult =<< options

 -- Functions we do not want in completions
 notWantedFuns :: [String]
--- a/Language/Haskell/GhcMod/Find.hs
+++ b/Language/Haskell/GhcMod/Find.hs
@ -28,7 +28,7 @@ import Language.Haskell.GhcMod.Utils
 import Language.Haskell.GhcMod.PathsAndFiles
 import Language.Haskell.GhcMod.Gap (listVisibleModules)
 import Name (getOccString)
-import Module (moduleNameString, moduleName)
+import Module (moduleName)
 import System.Directory (doesFileExist, getModificationTime)
 import System.FilePath ((</>), takeDirectory)
 import System.IO
@ -81,7 +81,7 @@ loadSymbolDb :: IOish m => GhcModT m SymbolDb
 loadSymbolDb = do
    ghcMod <- liftIO ghcModExecutable
    tmpdir <- cradleTempDir <$> cradle
-    file <- chop <$> readProcess' ghcMod ["dumpsym", tmpdir]
+    file <- liftIO $ chop <$> readProcess ghcMod ["dumpsym", tmpdir] ""
    !db <- M.fromAscList . map conv . lines <$> liftIO (readFile file)
    return $ SymbolDb {
        table = db
@ -102,12 +102,12 @@ loadSymbolDb = do
 --   The file name is printed.

 dumpSymbol :: IOish m => FilePath -> GhcModT m String
-dumpSymbol dir = do
+dumpSymbol dir = runGmPkgGhc $ do
    let cache = dir </> symbolCacheFile
        pkgdb = dir </> packageCache

    create <- liftIO $ cache `isOlderThan` pkgdb
-    when create $ (liftIO . writeSymbolCache cache) =<< getSymbolTable
+    when create $ (liftIO . writeSymbolCache cache) =<< getGlobalSymbolTable
    return $ unlines [cache]

 writeSymbolCache :: FilePath
@ -127,9 +127,9 @@ isOlderThan cache file = do
        tFile <- getModificationTime file
        return $ tCache <= tFile -- including equal just in case

-- | Browsing all functions in all system/user modules.
-getSymbolTable :: IOish m => GhcModT m [(Symbol,[ModuleString])]
-getSymbolTable = do
+-- | Browsing all functions in all system modules.
+getGlobalSymbolTable :: LightGhc [(Symbol,[ModuleString])]
+getGlobalSymbolTable = do
    df  <- G.getSessionDynFlags
    let mods = listVisibleModules df
    moduleInfos <- mapM G.getModuleInfo mods
--- a/Language/Haskell/GhcMod/GHCChoice.hs
+++ b/Language/Haskell/GhcMod/GHCChoice.hs
@ -1,23 +0,0 @@
-{-# LANGUAGE ScopedTypeVariables #-}
-
-module Language.Haskell.GhcMod.GHCChoice where
-
-import Control.Exception (IOException)
-import CoreMonad (liftIO)
-import qualified Exception as GE
-import GHC (GhcMonad)
-
----------------------------------------------------------------
-
-- | Try the left 'Ghc' action. If 'IOException' occurs, try
--   the right 'Ghc' action.
-(||>) :: GhcMonad m => m a -> m a -> m a
-x ||> y = x `GE.gcatch` (\(_ :: IOException) -> y)
-
-- | Go to the next 'Ghc' monad by throwing 'AltGhcgoNext'.
-goNext :: GhcMonad m => m a
-goNext = liftIO . GE.throwIO $ userError "goNext"
-
-- | Run any one 'Ghc' monad.
-runAnyOne :: GhcMonad m => [m a] -> m a
-runAnyOne = foldr (||>) goNext
--- a/Language/Haskell/GhcMod/Gap.hs
+++ b/Language/Haskell/GhcMod/Gap.hs
@ -13,7 +13,6 @@ module Language.Haskell.GhcMod.Gap (
  , showSeverityCaption
  , setCabalPkg
  , setHideAllPackages
-  , addPackageFlags
  , setDeferTypeErrors
  , setWarnTypedHoles
  , setDumpSplices
@ -33,16 +32,10 @@ module Language.Haskell.GhcMod.Gap (
  , fileModSummary
  , WarnFlags
  , emptyWarnFlags
-  , benchmarkBuildInfo
-  , benchmarkTargets
-  , toModuleString
  , GLMatch
  , GLMatchI
  , getClass
  , occName
-  , setFlags
-  , ghcVersion
-  , mkGHCCompilerId
  , listVisibleModuleNames
  , listVisibleModules
  , Language.Haskell.GhcMod.Gap.isSynTyCon
@ -51,19 +44,18 @@ module Language.Haskell.GhcMod.Gap (
 import Control.Applicative hiding (empty)
 import Control.Monad (filterM)
 import CoreSyn (CoreExpr)
-import Data.Version (parseVersion)
 import Data.List (intersperse)
 import Data.Maybe (catMaybes)
 import Data.Time.Clock (UTCTime)
+import Data.Traversable (traverse)
 import DataCon (dataConRepType)
 import Desugar (deSugarExpr)
 import DynFlags
 import ErrUtils
+import Exception
 import FastString
 import GhcMonad
 import HscTypes
-import Language.Haskell.GhcMod.GHCChoice
-import Language.Haskell.GhcMod.Types
 import NameSet
 import OccName
 import Outputable
@ -71,11 +63,8 @@ import PprTyThing
 import StringBuffer
 import TcType
 import Var (varType)
-import Config (cProjectVersion)
+import System.Directory

-import Text.ParserCombinators.ReadP (readP_to_S)
-
-import qualified Distribution.PackageDescription as P
 import qualified InstEnv
 import qualified Pretty
 import qualified StringBuffer as SB
@ -97,13 +86,6 @@ import Data.Convertible
 import RdrName (rdrNameOcc)
 #endif

-import Distribution.Version
-import Distribution.Simple.Compiler (CompilerId(..), CompilerFlavor(..))
-#if __GLASGOW_HASKELL__ >= 710
-import Distribution.Simple.Compiler (CompilerInfo(..), AbiTag(..))
-import Packages (listVisibleModuleNames, lookupModuleInAllPackages)
-#endif
-
 #if __GLASGOW_HASKELL__ < 710
 import UniqFM (eltsUFM)
 import Packages (exposedModules, exposed, pkgIdMap)
@ -112,7 +94,6 @@ import PackageConfig (PackageConfig, packageConfigId)

 #if __GLASGOW_HASKELL__ >= 704
 import qualified Data.IntSet as I (IntSet, empty)
-import qualified Distribution.ModuleName as M (ModuleName,toFilePath)
 #endif

 ----------------------------------------------------------------
@ -213,9 +194,11 @@ fOptions = [option | (option,_,_,_) <- fFlags]
 ----------------------------------------------------------------

 fileModSummary :: GhcMonad m => FilePath -> m ModSummary
-fileModSummary file = do
+fileModSummary file' = do
    mss <- getModuleGraph
-    let [ms] = filter (\m -> ml_hs_file (ms_location m) == Just file) mss
+    file <- liftIO $ canonicalizePath file'
+    [ms] <- liftIO $ flip filterM mss $ \m ->
+        (Just file==) <$> canonicalizePath `traverse` ml_hs_file (ms_location m)
    return ms

 withContext :: GhcMonad m => m a -> m a
@ -228,26 +211,31 @@ withContext action = gbracket setup teardown body
        action
    topImports = do
        mss <- getModuleGraph
-        ms <- map modName <$> filterM isTop mss
+        mns <- map modName <$> filterM isTop mss
+        let ii = map IIModule mns
 #if __GLASGOW_HASKELL__ >= 704
-        return ms
+        return ii
 #else
-        return (ms,[])
+        return (ii,[])
 #endif
    isTop mos = lookupMod mos ||> returnFalse
    lookupMod mos = lookupModule (ms_mod_name mos) Nothing >> return True
    returnFalse = return False
 #if __GLASGOW_HASKELL__ >= 706
-    modName = IIModule . moduleName . ms_mod
+    modName = moduleName . ms_mod
    setCtx = setContext
 #elif __GLASGOW_HASKELL__ >= 704
-    modName = IIModule . ms_mod
+    modName = ms_mod
    setCtx = setContext
 #else
    modName = ms_mod
    setCtx = uncurry setContext
 #endif

+-- | Try the left action, if an IOException occurs try the right action.
+(||>) :: ExceptionMonad m => m a -> m a -> m a
+x ||> y = x `gcatch` (\(_ :: IOException) -> y)
+
 showSeverityCaption :: Severity -> String
 #if __GLASGOW_HASKELL__ >= 706
 showSeverityCaption SevWarning = "Warning: "
@ -275,17 +263,6 @@ setHideAllPackages df = gopt_set df Opt_HideAllPackages
 setHideAllPackages df = dopt_set df Opt_HideAllPackages
 #endif

-addPackageFlags :: [Package] -> DynFlags -> DynFlags
-addPackageFlags pkgs df =
-    df { packageFlags = packageFlags df ++ expose `map` pkgs }
-  where
-#if __GLASGOW_HASKELL__ >= 710
-    expose :: Package -> PackageFlag
-    expose pkg = ExposePackage (PackageIdArg $ showPkgId pkg) (ModRenaming True [])
-#else
-    expose pkg = ExposePackageId $ showPkgId pkg
-#endif
-
 ----------------------------------------------------------------

 setDumpSplices :: DynFlags -> DynFlags
@ -444,29 +421,6 @@ emptyWarnFlags = []
 ----------------------------------------------------------------
 ----------------------------------------------------------------

-benchmarkBuildInfo :: P.PackageDescription -> [P.BuildInfo]
-#if __GLASGOW_HASKELL__ >= 704
-benchmarkBuildInfo pd = map P.benchmarkBuildInfo $ P.benchmarks pd
-#else
-benchmarkBuildInfo pd = []
-#endif
-
-benchmarkTargets :: P.PackageDescription -> [String]
-#if __GLASGOW_HASKELL__ >= 704
-benchmarkTargets pd = map toModuleString $ concatMap P.benchmarkModules $ P.benchmarks pd
-#else
-benchmarkTargets = []
-#endif
-
-toModuleString :: M.ModuleName -> String
-toModuleString mn = fromFilePath $ M.toFilePath mn
-  where
-    fromFilePath :: FilePath -> String
-    fromFilePath fp = map (\c -> if c=='/' then '.' else c) fp
-
----------------------------------------------------------------
----------------------------------------------------------------
-
 #if __GLASGOW_HASKELL__ >= 708
 type GLMatch = LMatch RdrName (LHsExpr RdrName)
 type GLMatchI = LMatch Id (LHsExpr Id)
@ -502,35 +456,6 @@ occName = rdrNameOcc

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

-setFlags :: DynFlags -> DynFlags
-#if __GLASGOW_HASKELL__ >= 708
-setFlags df = df `gopt_unset` Opt_SpecConstr -- consume memory if -O2
-#else
-setFlags = id
-#endif
-
----------------------------------------------------------------
-
-ghcVersion :: Version
-ghcVersion =
-    case readP_to_S parseVersion $ cProjectVersion  of
-      [(ver, "")] -> ver
-      _ -> error "parsing ghc version(cProjectVersion) failed."
-
-
-#if __GLASGOW_HASKELL__ >= 710
-mkGHCCompilerId :: Version -> Distribution.Simple.Compiler.CompilerInfo
-- TODO we should probably fill this out properly
-mkGHCCompilerId v =
-    CompilerInfo (CompilerId GHC v) NoAbiTag Nothing Nothing Nothing
-#else
-mkGHCCompilerId :: Version -> CompilerId
-mkGHCCompilerId v = CompilerId GHC v
-#endif
-
----------------------------------------------------------------
-
-
 #if __GLASGOW_HASKELL__ < 710
 -- Copied from ghc/InteractiveUI.hs
 allExposedPackageConfigs :: DynFlags -> [PackageConfig]
--- a/Language/Haskell/GhcMod/GhcPkg.hs
+++ b/Language/Haskell/GhcMod/GhcPkg.hs
@ -4,20 +4,14 @@ module Language.Haskell.GhcMod.GhcPkg (
  , ghcPkgDbStackOpts
  , ghcDbStackOpts
  , ghcDbOpt
-  , fromInstalledPackageId
-  , fromInstalledPackageId'
-  , getPackageDbStack
  , getPackageCachePaths
  ) where

 import Config (cProjectVersion, cTargetPlatformString, cProjectVersionInt)
 import Control.Applicative ((<$>))
-import Data.List (intercalate)
 import Data.List.Split (splitOn)
 import Data.Maybe
-import Distribution.Package (InstalledPackageId(..))
 import Exception (handleIO)
-import Language.Haskell.GhcMod.PathsAndFiles
 import Language.Haskell.GhcMod.Types
 import System.Directory (doesDirectoryExist, getAppUserDataDirectory)
 import System.FilePath ((</>))
@ -25,29 +19,6 @@ import System.FilePath ((</>))
 ghcVersion :: Int
 ghcVersion = read cProjectVersionInt

-getPackageDbStack :: FilePath -- ^ Project Directory (where the
-                                 -- cabal.sandbox.config file would be if it
-                                 -- exists)
-                  -> IO [GhcPkgDb]
-getPackageDbStack cdir =
-    ([GlobalDb] ++) . maybe [UserDb] return <$> getSandboxDb cdir
-
----------------------------------------------------------------
-
-fromInstalledPackageId' :: InstalledPackageId -> Maybe Package
-fromInstalledPackageId' pid = let
-    InstalledPackageId pkg = pid
-    in case reverse $ splitOn "-" pkg of
-      i:v:rest -> Just (intercalate "-" (reverse rest), v, i)
-      _ -> Nothing
-
-fromInstalledPackageId :: InstalledPackageId -> Package
-fromInstalledPackageId pid =
-    case fromInstalledPackageId' pid of
-      Just p -> p
-      Nothing -> error $
-        "fromInstalledPackageId: `"++show pid++"' is not a valid package-id"
-
 ----------------------------------------------------------------

 -- | Get options needed to add a list of package dbs to ghc-pkg's db stack
@ -82,12 +53,10 @@ ghcDbOpt (PackageDb pkgDb)

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

-
 getPackageCachePaths :: FilePath -> Cradle -> IO [FilePath]
 getPackageCachePaths sysPkgCfg crdl =
    catMaybes <$> resolvePackageConfig sysPkgCfg `mapM` cradlePkgDbStack crdl

-
 -- TODO: use PkgConfRef
 --- Copied from ghc module `Packages' unfortunately it's not exported :/
 resolvePackageConfig :: FilePath -> GhcPkgDb -> IO (Maybe FilePath)
--- a/Language/Haskell/GhcMod/HomeModuleGraph.hs
+++ b/Language/Haskell/GhcMod/HomeModuleGraph.hs
@ -0,0 +1,270 @@
+-- ghc-mod: Making Haskell development *more* fun
+-- Copyright (C) 2015  Daniel Gröber <dxld ÄT darkboxed DOT org>
+--
+-- This program is free software: you can redistribute it and/or modify
+-- it under the terms of the GNU Affero General Public License as published by
+-- the Free Software Foundation, either version 3 of the License, or
+-- (at your option) any later version.
+--
+-- This program is distributed in the hope that it will be useful,
+-- but WITHOUT ANY WARRANTY; without even the implied warranty of
+-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+-- GNU Affero General Public License for more details.
+--
+-- You should have received a copy of the GNU Affero General Public License
+-- along with this program.  If not, see <http://www.gnu.org/licenses/>.
+
+{-# LANGUAGE ScopedTypeVariables, RecordWildCards #-}
+module Language.Haskell.GhcMod.HomeModuleGraph (
+   GmModuleGraph(..)
+ , ModulePath(..)
+ , mkFileMap
+ , mkModuleMap
+ , mkMainModulePath
+ , findModulePath
+ , findModulePathSet
+ , fileModuleName
+ , homeModuleGraph
+ , updateHomeModuleGraph
+ , reachable
+ , moduleGraphToDot
+ ) where
+
+import Bag
+import DriverPipeline hiding (unP)
+import ErrUtils
+import Exception
+import FastString
+import Finder
+import GHC
+import HscTypes
+import Lexer
+import MonadUtils hiding (foldrM)
+import Parser
+import SrcLoc
+import StringBuffer
+
+import Control.Arrow ((&&&))
+import Control.Monad
+import Control.Monad.Trans.Maybe (MaybeT(..), runMaybeT)
+import Control.Monad.State.Strict (execStateT)
+import Control.Monad.State.Class
+import Data.Maybe
+import Data.Monoid
+import Data.Map.Strict  (Map)
+import qualified Data.Map.Strict  as Map
+import Data.Set (Set)
+import qualified Data.Set as Set
+import System.FilePath
+
+import Language.Haskell.GhcMod.Logging
+import Language.Haskell.GhcMod.Logger
+import Language.Haskell.GhcMod.Monad.Types
+import Language.Haskell.GhcMod.Types
+
+-- | Turn module graph into a graphviz dot file
+--
+-- @dot -Tpng -o modules.png modules.dot@
+moduleGraphToDot :: GmModuleGraph -> String
+moduleGraphToDot GmModuleGraph { gmgGraph } =
+    "digraph {\n" ++ concatMap edges (Map.toList graph) ++ "}\n"
+ where
+   graph = Map.map (Set.mapMonotonic mpPath)
+         $ Map.mapKeysMonotonic mpPath gmgGraph
+   edges :: (FilePath, (Set FilePath)) -> String
+   edges (f, sf) =
+       concatMap (\f' -> "    \""++ f ++"\" -> \""++ f' ++"\"\n") (Set.toList sf)
+
+data S = S {
+      sErrors   :: [(ModulePath, ErrorMessages)],
+      sWarnings :: [(ModulePath, WarningMessages)],
+      sGraph    :: GmModuleGraph
+}
+
+defaultS :: S
+defaultS = S [] [] mempty
+
+putErr :: MonadState S m
+       => (ModulePath, ErrorMessages) -> m ()
+putErr e = do
+  s <- get
+  put s { sErrors = e:sErrors s}
+
+putWarn :: MonadState S m
+       => (ModulePath, ErrorMessages) -> m ()
+putWarn w = do
+  s <- get
+  put s { sWarnings = w:sWarnings s}
+
+gmgLookupMP :: MonadState S m => ModulePath -> m (Maybe (Set ModulePath))
+gmgLookupMP k = (Map.lookup k . gmgGraph . sGraph) `liftM` get
+
+graphUnion :: MonadState S m => GmModuleGraph -> m ()
+graphUnion gmg = do
+  s <- get
+  put s { sGraph = sGraph s `mappend` gmg }
+
+reachable :: Set ModulePath -> GmModuleGraph -> Set ModulePath
+reachable smp0 GmModuleGraph {..} = go smp0
+ where
+   go smp = let
+       δsmp = Set.unions $
+                collapseMaybeSet . flip Map.lookup gmgGraph <$> Set.toList smp
+       smp' = smp `Set.union` δsmp
+    in if smp == smp' then smp' else go smp'
+
+pruneUnreachable :: Set ModulePath -> GmModuleGraph -> GmModuleGraph
+pruneUnreachable smp0 gmg@GmModuleGraph {..} = let
+    r = reachable smp0 gmg
+    rfn = Set.map mpPath r
+    rmn = Set.map mpModule r
+  in
+    GmModuleGraph {
+      gmgFileMap = Map.filterWithKey (\k _ -> k `Set.member` rfn) gmgFileMap,
+      gmgModuleMap = Map.filterWithKey (\k _ -> k `Set.member` rmn) gmgModuleMap,
+      gmgGraph = Map.filterWithKey (\k _ -> k `Set.member` r) gmgGraph
+    }
+
+collapseMaybeSet :: Maybe (Set a) -> Set a
+collapseMaybeSet = maybe Set.empty id
+
+homeModuleGraph :: (IOish m, GmLog m, GmEnv m)
+    => HscEnv -> Set ModulePath -> m GmModuleGraph
+homeModuleGraph env smp = updateHomeModuleGraph env mempty smp smp
+
+mkMainModulePath :: FilePath -> ModulePath
+mkMainModulePath = ModulePath (mkModuleName "Main")
+
+findModulePath :: HscEnv -> ModuleName -> IO (Maybe ModulePath)
+findModulePath env mn = do
+    fmap (ModulePath mn) <$> find env mn
+
+findModulePathSet :: HscEnv -> [ModuleName] -> IO (Set ModulePath)
+findModulePathSet env mns = do
+    Set.fromList . catMaybes <$> findModulePath env `mapM` mns
+
+find :: MonadIO m => HscEnv -> ModuleName -> m (Maybe FilePath)
+find env mn = liftIO $ do
+  res <- findHomeModule env mn
+  case res of
+   -- TODO: handle SOURCE imports (hs-boot stuff): addBootSuffixLocn loc
+    Found loc@ModLocation { ml_hs_file = Just _ } _mod -> do
+        return $ normalise <$> ml_hs_file loc
+    _ -> return Nothing
+
+updateHomeModuleGraph :: (IOish m, GmLog m, GmEnv m)
+                      => HscEnv
+                      -> GmModuleGraph
+                      -> Set ModulePath -- ^ Initial set of modules
+                      -> Set ModulePath -- ^ Updated set of modules
+                      -> m GmModuleGraph
+updateHomeModuleGraph env GmModuleGraph {..} smp usmp = do
+    -- TODO: It would be good if we could retain information about modules that
+    -- stop to compile after we've already successfully parsed them at some
+    -- point. Figure out a way to delete the modules about to be updated only
+    -- after we're sure they won't fail to parse .. or something. Should probably
+    -- push this whole prune logic deep into updateHomeModuleGraph'
+   (pruneUnreachable smp . sGraph) `liftM` runS (updateHomeModuleGraph' env usmp)
+ where
+   runS = flip execStateT defaultS { sGraph = graph' }
+   graph' = GmModuleGraph {
+       gmgFileMap = Set.foldr (Map.delete . mpPath) gmgFileMap usmp,
+       gmgModuleMap = Set.foldr (Map.delete . mpModule) gmgModuleMap usmp,
+       gmgGraph = Set.foldr Map.delete gmgGraph usmp
+    }
+
+mkFileMap :: Set ModulePath -> Map FilePath ModulePath
+mkFileMap smp = Map.fromList $ map (mpPath &&& id) $ Set.toList smp
+
+mkModuleMap :: Set ModulePath -> Map ModuleName ModulePath
+mkModuleMap smp = Map.fromList $ map (mpModule &&& id) $ Set.toList smp
+
+updateHomeModuleGraph'
+    :: forall m. (MonadState S m, IOish m, GmLog m, GmEnv m)
+    => HscEnv
+    -> Set ModulePath     -- ^ Initial set of modules
+    -> m ()
+updateHomeModuleGraph' env smp0 = do
+    go `mapM_` Set.toList smp0
+
+ where
+   go :: ModulePath -> m ()
+   go mp = do
+     msmp <- gmgLookupMP mp
+     case msmp of
+       Just _ -> return ()
+       Nothing -> do
+           smp <- collapseMaybeSet `liftM` step mp
+
+           graphUnion GmModuleGraph {
+               gmgFileMap = mkFileMap smp,
+               gmgModuleMap = mkModuleMap smp,
+               gmgGraph = Map.singleton mp smp
+            }
+
+           mapM_ go (Set.toList smp)
+
+   step :: ModulePath -> m (Maybe (Set ModulePath))
+   step mp = runMaybeT $ do
+       (dflags, ppsrc_fn) <- MaybeT preprocess'
+       src <- liftIO $ readFile ppsrc_fn
+       imports mp src dflags
+    where
+      preprocess' :: m (Maybe (DynFlags, FilePath))
+      preprocess' = do
+        let fn = mpPath mp
+        ep <- liftIO $ withLogger' env $ \setDf -> let
+              env' = env { hsc_dflags = setDf (hsc_dflags env) }
+           in preprocess env' (fn, Nothing)
+        case ep of
+          Right (_, x) -> return $ Just x
+          Left errs -> do
+            -- TODO: Remember these and present them as proper errors if this is
+            -- the file the user is looking at.
+            gmLog GmWarning "preprocess'" $ vcat $ map strDoc errs
+            return Nothing
+
+   imports :: ModulePath -> String -> DynFlags -> MaybeT m (Set ModulePath)
+   imports mp@ModulePath {..} src dflags =
+       case parseModuleHeader src dflags mpPath of
+         Left err -> do
+           putErr (mp, err)
+           mzero
+
+         Right (ws, lmdl) -> do
+           putWarn (mp, ws)
+           let HsModule {..} = unLoc lmdl
+               mns = map (unLoc . ideclName)
+                   $ filter (isNothing . ideclPkgQual)
+                   $ map unLoc hsmodImports
+           liftIO $ Set.fromList . catMaybes <$> mapM (findModulePath env) mns
+
+fileModuleName :: HscEnv
+               -> FilePath
+               -> IO (Either ErrorMessages (Maybe ModuleName))
+fileModuleName env fn = handle (\(_ :: SomeException) -> return $ Right Nothing) $ do
+    src <- readFile fn
+    case parseModuleHeader src (hsc_dflags env) fn of
+      Left errs -> return (Left errs)
+      Right (_, lmdl) -> do
+        let HsModule {..} = unLoc lmdl
+        return $ Right $ unLoc <$> hsmodName
+
+parseModuleHeader
+    :: String         -- ^ Haskell module source text (full Unicode is supported)
+    -> DynFlags
+    -> FilePath       -- ^ the filename (for source locations)
+    -> Either ErrorMessages (WarningMessages, Located (HsModule RdrName))
+parseModuleHeader str dflags filename =
+   let
+       loc  = mkRealSrcLoc (mkFastString filename) 1 1
+       buf  = stringToStringBuffer str
+   in
+   case unP Parser.parseHeader (mkPState dflags buf loc) of
+
+     PFailed sp err   ->
+         Left (unitBag (mkPlainErrMsg dflags sp err))
+
+     POk pst rdr_module ->
+         let (warns,_) = getMessages pst in
+         Right (warns, rdr_module)
--- a/Language/Haskell/GhcMod/Info.hs
+++ b/Language/Haskell/GhcMod/Info.hs
@ -7,16 +7,20 @@ import Control.Applicative ((<$>))
 import Data.Function (on)
 import Data.List (sortBy)
 import Data.Maybe (catMaybes)
+import System.FilePath
 import Exception (ghandle, SomeException(..))
 import GHC (GhcMonad, LHsBind, LHsExpr, LPat, Id, TypecheckedModule(..), SrcSpan, Type)
 import qualified GHC as G
-import Language.Haskell.GhcMod.Doc (showPage)
-import Language.Haskell.GhcMod.Gap (HasType(..))
 import qualified Language.Haskell.GhcMod.Gap as Gap
+
+import Language.Haskell.GhcMod.Convert
+import Language.Haskell.GhcMod.Doc
+import Language.Haskell.GhcMod.DynFlags
+import Language.Haskell.GhcMod.Gap
+import Language.Haskell.GhcMod.Logging
 import Language.Haskell.GhcMod.Monad
 import Language.Haskell.GhcMod.SrcUtils
 import Language.Haskell.GhcMod.Types
-import Language.Haskell.GhcMod.Convert

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

@ -25,14 +29,21 @@ info :: IOish m
     => FilePath     -- ^ A target file.
     -> Expression   -- ^ A Haskell expression.
     -> GhcModT m String
-info file expr = do
+info file expr = runGmLoadedT' [Left file] deferErrors $ withContext $ do
    opt <- options
    convert opt <$> ghandle handler body
  where
-    body = inModuleContext file $ \dflag style -> do
+    handler (SomeException ex) = do
+        gmLog GmException "info" $
+                text "" $$ nest 4 (showDoc ex)
+        return "Cannot show info"
+
+    body = do
        sdoc <- Gap.infoThing expr
-        return $ showPage dflag style sdoc
-    handler (SomeException _) = return "Cannot show info"
+        st <- getStyle
+        dflag <- G.getSessionDynFlags
+        return $ showPage dflag st sdoc
+

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

@ -42,15 +53,18 @@ types :: IOish m
      -> Int          -- ^ Line number.
      -> Int          -- ^ Column number.
      -> GhcModT m String
-types file lineNo colNo = do
-    opt <- options
-    convert opt <$> ghandle handler body
-  where
-    body = inModuleContext file $ \dflag style -> do
-        modSum <- Gap.fileModSummary file
+types file lineNo colNo =
+    runGmLoadedT' [Left file] deferErrors $ ghandle handler $ withContext $ do
+        crdl <- cradle
+        modSum <- Gap.fileModSummary (cradleCurrentDir crdl </> file)
        srcSpanTypes <- getSrcSpanType modSum lineNo colNo
-        return $ map (toTup dflag style) $ sortBy (cmp `on` fst) srcSpanTypes
-    handler (SomeException _) = return []
+
+        dflag <- G.getSessionDynFlags
+        st <- getStyle
+
+        convert' $ map (toTup dflag st) $ sortBy (cmp `on` fst) srcSpanTypes
+ where
+   handler (SomeException _) = return []

 getSrcSpanType :: GhcMonad m => G.ModSummary -> Int -> Int -> m [(SrcSpan, Type)]
 getSrcSpanType modSum lineNo colNo = do
--- a/Language/Haskell/GhcMod/Internal.hs
+++ b/Language/Haskell/GhcMod/Internal.hs
@ -8,28 +8,16 @@ module Language.Haskell.GhcMod.Internal (
  , PackageVersion
  , PackageId
  , IncludeDir
-  , CompilerOptions(..)
-  -- * Cabal API
-  , parseCabalFile
-  , getCompilerOptions
-  , cabalAllBuildInfo
-  , cabalSourceDirs
  -- * Various Paths
  , ghcLibDir
  , ghcModExecutable
-  -- * IO
-  , getDynamicFlags
-  -- * Targets
-  , setTargetFiles
  -- * Logging
  , withLogger
  , setNoWarningFlags
  , setAllWarningFlags
  -- * Environment, state and logging
  , GhcModEnv(..)
-  , newGhcModEnv
  , GhcModState
-  , defaultState
  , CompilerMode(..)
  , GhcModLog
  -- * Monad utilities
@ -43,10 +31,6 @@ module Language.Haskell.GhcMod.Internal (
  , withOptions
  -- * 'GhcModError'
  , gmeDoc
-  -- * 'GhcMonad' Choice
-  , (||>)
-  , goNext
-  , runAnyOne
  -- * World
  , World
  , getCurrentWorld
@ -55,13 +39,10 @@ module Language.Haskell.GhcMod.Internal (

 import GHC.Paths (libdir)

-import Language.Haskell.GhcMod.CabalApi
 import Language.Haskell.GhcMod.DynFlags
 import Language.Haskell.GhcMod.Error
-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
 import Language.Haskell.GhcMod.Utils
 import Language.Haskell.GhcMod.World
--- a/Language/Haskell/GhcMod/Logger.hs
+++ b/Language/Haskell/GhcMod/Logger.hs
@ -1,30 +1,30 @@
-{-# LANGUAGE CPP #-}
-
 module Language.Haskell.GhcMod.Logger (
    withLogger
+  , withLogger'
  , checkErrorPrefix
  ) where

-import Bag (Bag, bagToList)
+import Control.Arrow
 import Control.Applicative ((<$>))
-import Data.IORef (IORef, newIORef, readIORef, writeIORef, modifyIORef)
 import Data.List (isPrefixOf)
 import Data.Maybe (fromMaybe)
-import ErrUtils (ErrMsg, errMsgShortDoc, errMsgExtraInfo)
-import Exception (ghandle)
-import GHC (DynFlags, SrcSpan, Severity(SevError))
-import qualified GHC as G
-import HscTypes (SourceError, srcErrorMessages)
-import Language.Haskell.GhcMod.Doc (showPage, getStyle)
-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 Data.IORef (IORef, newIORef, readIORef, writeIORef, modifyIORef)
 import System.FilePath (normalise)
+import Text.PrettyPrint

----------------------------------------------------------------
+import Bag (Bag, bagToList)
+import ErrUtils (ErrMsg, errMsgShortDoc, errMsgExtraInfo)
+import GHC (DynFlags, SrcSpan, Severity(SevError))
+import HscTypes
+import Outputable
+import qualified GHC as G
+
+import Language.Haskell.GhcMod.Convert
+import Language.Haskell.GhcMod.Doc (showPage)
+import Language.Haskell.GhcMod.DynFlags (withDynFlags)
+import Language.Haskell.GhcMod.Monad.Types
+import Language.Haskell.GhcMod.Error
+import qualified Language.Haskell.GhcMod.Gap as Gap

 type Builder = [String] -> [String]

@ -38,16 +38,16 @@ emptyLog = Log [] id
 newLogRef :: IO LogRef
 newLogRef = LogRef <$> newIORef emptyLog

-readAndClearLogRef :: IOish m => LogRef -> GhcModT m String
+readAndClearLogRef :: LogRef -> IO [String]
 readAndClearLogRef (LogRef ref) = do
-    Log _ b <- liftIO $ readIORef ref
-    liftIO $ writeIORef ref emptyLog
-    convert' (b [])
+    Log _ b <- readIORef ref
+    writeIORef ref emptyLog
+    return $ b []

 appendLogRef :: DynFlags -> LogRef -> DynFlags -> Severity -> SrcSpan -> PprStyle -> SDoc -> IO ()
-appendLogRef df (LogRef ref) _ sev src style msg = modifyIORef ref update
+appendLogRef df (LogRef ref) _ sev src st msg = modifyIORef ref update
  where
-    l = ppMsg src sev df style msg
+    l = ppMsg src sev df st msg
    update lg@(Log ls b)
      | l `elem` ls = lg
      | otherwise   = Log (l:ls) (b . (l:))
@ -57,56 +57,68 @@ appendLogRef df (LogRef ref) _ sev src style msg = modifyIORef ref update
 -- | Set the session flag (e.g. "-Wall" or "-w:") then
 --   executes a body. Logged messages are returned as 'String'.
 --   Right is success and Left is failure.
-withLogger :: IOish m
+withLogger :: (GmGhc m, GmEnv m)
           => (DynFlags -> DynFlags)
-           -> GhcModT m ()
-           -> GhcModT m (Either String String)
-withLogger setDF body = ghandle sourceError $ do
-    logref <- liftIO newLogRef
-    wflags <- filter ("-fno-warn" `isPrefixOf`) . ghcUserOptions <$> options
-    withDynFlags (setLogger logref . setDF) $
-        withCmdFlags wflags $ do
-            body
-            Right <$> readAndClearLogRef logref
+           -> m a
+           -> m (Either String (String, a))
+withLogger f action = do
+  env <- G.getSession
+  opts <- options
+  let conv = convert opts
+  eres <- withLogger' env $ \setDf ->
+      withDynFlags (f . setDf) action
+  return $ either (Left . conv) (Right . first conv) eres
+
+withLogger' :: IOish m
+    => HscEnv -> ((DynFlags -> DynFlags) -> m a) -> m (Either [String] ([String], a))
+withLogger' env action = do
+    logref <- liftIO $ newLogRef
+
+    let dflags = hsc_dflags env
+        pu = icPrintUnqual dflags (hsc_IC env)
+        st = mkUserStyle pu AllTheWay
+
+        fn df  = setLogger logref df
+
+    a <- gcatches (Right <$> action fn) (handlers dflags st)
+    ls <- liftIO $ readAndClearLogRef logref
+
+    return $ ((,) ls <$> a)
+
  where
    setLogger logref df = Gap.setLogAction df $ appendLogRef df logref
+    handlers df st = [
+        GHandler $ \ex -> return $ Left $ sourceError df st ex,
+        GHandler $ \ex -> return $ Left [render $ ghcExceptionDoc ex]
+     ]

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

 -- | Converting 'SourceError' to 'String'.
-sourceError :: IOish m => SourceError -> GhcModT m (Either String String)
-sourceError err = errBagToStr (srcErrorMessages err)
-
-errBagToStr :: IOish m => Bag ErrMsg -> GhcModT m (Either String String)
-errBagToStr = errBagToStr' Left
-
-errBagToStr' :: IOish m => (String -> a) -> Bag ErrMsg -> GhcModT m a
-errBagToStr' f err = do
-    dflags <- G.getSessionDynFlags
-    style <- getStyle
-    ret <- convert' (errBagToStrList dflags style err)
-    return $ f ret
+sourceError :: DynFlags -> PprStyle -> SourceError -> [String]
+sourceError df st src_err = errBagToStrList df st $ srcErrorMessages src_err

 errBagToStrList :: DynFlags -> PprStyle -> Bag ErrMsg -> [String]
-errBagToStrList dflag style = map (ppErrMsg dflag style) . reverse . bagToList
+errBagToStrList df st = map (ppErrMsg df st) . reverse . bagToList

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

 ppErrMsg :: DynFlags -> PprStyle -> ErrMsg -> String
-ppErrMsg dflag style err = ppMsg spn SevError dflag style msg ++ (if null ext then "" else "\n" ++ ext)
+ppErrMsg dflag st err =
+    ppMsg spn SevError dflag st msg ++ (if null ext then "" else "\n" ++ ext)
   where
     spn = Gap.errorMsgSpan err
     msg = errMsgShortDoc err
-     ext = showPage dflag style (errMsgExtraInfo err)
+     ext = showPage dflag st (errMsgExtraInfo err)

 ppMsg :: SrcSpan -> Severity-> DynFlags -> PprStyle -> SDoc -> String
-ppMsg spn sev dflag style msg = prefix ++ cts
+ppMsg spn sev dflag st msg = prefix ++ cts
  where
-    cts  = showPage dflag style msg
-    prefix = ppMsgPrefix spn sev dflag style cts
+    cts  = showPage dflag st msg
+    prefix = ppMsgPrefix spn sev dflag st cts

 ppMsgPrefix :: SrcSpan -> Severity-> DynFlags -> PprStyle -> String -> String
-ppMsgPrefix spn sev dflag _style cts =
+ppMsgPrefix spn sev dflag _st cts =
  let defaultPrefix
        | Gap.isDumpSplices dflag = ""
        | otherwise               = checkErrorPrefix
--- a/Language/Haskell/GhcMod/Logging.hs
+++ b/Language/Haskell/GhcMod/Logging.hs
@ -1,4 +1,3 @@
-module Language.Haskell.GhcMod.Logging where
 -- ghc-mod: Making Haskell development *more* fun
 -- Copyright (C) 2015  Daniel Gröber <dxld ÄT darkboxed DOT org>
 --
@ -15,22 +14,45 @@ module Language.Haskell.GhcMod.Logging where
 -- You should have received a copy of the GNU Affero General Public License
 -- along with this program.  If not, see <http://www.gnu.org/licenses/>.

-import Language.Haskell.GhcMod.Types
-import Language.Haskell.GhcMod.Monad.Types
+module Language.Haskell.GhcMod.Logging (
+    module Language.Haskell.GhcMod.Logging
+  , module Language.Haskell.GhcMod.Pretty
+  , GmLogLevel(..)
+  , module Text.PrettyPrint
+  , module Data.Monoid
+  ) where

-import Control.Monad.Journal.Class
-import Control.Monad.Trans.Class
+import Control.Monad
+import Data.Monoid (mempty, mappend, mconcat, (<>))
 import System.IO
+import Text.PrettyPrint hiding (style, (<>))

-import MonadUtils
+import Language.Haskell.GhcMod.Monad.Types
+import Language.Haskell.GhcMod.Pretty

--gmSink :: IOish m => (GhcModLog -> IO ()) -> GhcModT m ()
--gmSink = GhcModT . (lift . lift . sink)
+gmSetLogLevel :: GmLog m => GmLogLevel -> m ()
+gmSetLogLevel level =
+    gmlJournal $ GhcModLog (Just level) []

-type GmLog m = MonadJournal GhcModLog m
+increaseLogLevel :: GmLogLevel -> GmLogLevel
+increaseLogLevel l | l == maxBound = l
+increaseLogLevel l = succ l

-gmJournal :: IOish m => GhcModLog -> GhcModT m ()
-gmJournal = GhcModT . lift . lift . journal
+-- |
+-- >>> Just GmDebug <= Nothing
+-- False
+-- >>> Just GmException <= Just GmDebug
+-- True
+-- >>> Just GmDebug <= Just GmException
+-- False
+gmLog :: (MonadIO m, GmLog m) => GmLogLevel -> String -> Doc -> m ()
+gmLog level loc' doc = do
+  GhcModLog { gmLogLevel = level' } <- gmlHistory

-gmLog :: (MonadIO m, MonadJournal GhcModLog m) => String -> m ()
-gmLog str = liftIO (hPutStrLn stderr str) >> (journal $ GhcModLog [str])
+  let loc | loc' == "" = empty
+          | otherwise = text (head $ lines loc') <> colon
+      msg = gmRenderDoc $ gmLogLevelDoc level <+> loc <+> doc
+
+  when (Just level <= level') $
+       liftIO $ hPutStrLn stderr msg
+  gmlJournal (GhcModLog Nothing [(level, render loc, msg)])
--- a/Language/Haskell/GhcMod/Modules.hs
+++ b/Language/Haskell/GhcMod/Modules.hs
@ -1,6 +1,5 @@
 module Language.Haskell.GhcMod.Modules (modules) where

-import Control.Applicative ((<$>))
 import qualified GHC as G
 import Language.Haskell.GhcMod.Convert
 import Language.Haskell.GhcMod.Monad
@ -10,5 +9,7 @@ import Module (moduleNameString)
 ----------------------------------------------------------------

 -- | Listing installed modules.
-modules :: IOish m => GhcModT m String
-modules = convert' =<< map moduleNameString . listVisibleModuleNames <$> G.getSessionDynFlags
+modules :: (IOish m, GmEnv m) => m String
+modules = do
+  dflags <- runGmPkgGhc G.getSessionDynFlags
+  convert' $ map moduleNameString $ listVisibleModuleNames dflags
--- a/Language/Haskell/GhcMod/Monad.hs
+++ b/Language/Haskell/GhcMod/Monad.hs
@ -1,4 +1,3 @@
-{-# LANGUAGE CPP, RecordWildCards #-}
 -- ghc-mod: Making Haskell development *more* fun
 -- Copyright (C) 2015  Daniel Gröber <dxld ÄT darkboxed DOT org>
 --
@ -14,166 +13,74 @@
 --
 -- You should have received a copy of the GNU Affero General Public License
 -- along with this program.  If not, see <http://www.gnu.org/licenses/>.
+
+{-# LANGUAGE CPP #-}
 module Language.Haskell.GhcMod.Monad (
-  -- * Monad Types
-    GhcModT
-  , IOish
-  -- ** Environment, state and logging
-  , GhcModEnv(..)
-  , newGhcModEnv
-  , GhcModState(..)
-  , defaultState
-  , CompilerMode(..)
-  , GhcModLog
-  , GhcModError(..)
-  -- * Monad utilities
-  , runGhcModT
+    runGhcModT
  , runGhcModT'
+  , runGhcModT''
  , hoistGhcModT
-  -- ** Accessing 'GhcModEnv', 'GhcModState' and 'GhcModLog'
-  , gmsGet
-  , gmsPut
-  , gmLog
-  , options
-  , cradle
-  , getCompilerMode
-  , setCompilerMode
-  , withOptions
-  , withTempSession
-  -- ** Re-exporting convenient stuff
-  , liftIO
-  , module Control.Monad.Reader.Class
+  , runGmLoadedT
+  , runGmLoadedT'
+  , runGmLoadedTWith
+  , runGmPkgGhc
+  , withGhcModEnv
+  , withGhcModEnv'
+  , module Language.Haskell.GhcMod.Monad.Types
  ) where

 import Language.Haskell.GhcMod.Types
 import Language.Haskell.GhcMod.Monad.Types
-import Language.Haskell.GhcMod.Logging
 import Language.Haskell.GhcMod.Error
+import Language.Haskell.GhcMod.Logging
 import Language.Haskell.GhcMod.Cradle
-import Language.Haskell.GhcMod.DynFlags
-import Language.Haskell.GhcMod.GhcPkg
-import Language.Haskell.GhcMod.CabalApi
-import Language.Haskell.GhcMod.CabalConfig
-import qualified Language.Haskell.GhcMod.Gap as Gap
-
-import GHC
-import qualified GHC as G
-import GHC.Paths (libdir)
-import GhcMonad hiding (withTempSession)
-#if __GLASGOW_HASKELL__ <= 702
-import HscTypes
-#endif
-
-- MonadUtils of GHC 7.6 or earlier defines its own MonadIO.
-- RWST does not automatically become an instance of MonadIO.
-- MonadUtils of GHC 7.8 or later imports MonadIO in Monad.Control.IO.Class.
-- So, RWST automatically becomes an instance of MonadIO.
-import MonadUtils
+import Language.Haskell.GhcMod.Target

 import Control.Arrow (first)
-import Control.Monad (void)
-#if !MIN_VERSION_monad_control(1,0,0)
-import Control.Monad (liftM)
-#endif
-import Control.Monad.Base (liftBase)
+import Control.Applicative

-import Control.Monad.Reader.Class
-import Control.Monad.State.Class (MonadState(..))
-
-import Control.Monad.Error (runErrorT)
 import Control.Monad.Reader (runReaderT)
 import Control.Monad.State.Strict (runStateT)
 import Control.Monad.Trans.Journal (runJournalT)

-import Data.Maybe (isJust)
-import Data.IORef
-import System.Directory (getCurrentDirectory)
+import Exception (ExceptionMonad(..))

----------------------------------------------------------------
+import System.Directory

-- | Initialize the 'DynFlags' relating to the compilation of a single
-- file or GHC session according to the 'Cradle' and 'Options'
-- provided.
-initializeFlagsWithCradle :: (IOish m, GhcMonad m, GmError m, GmLog m)
-        => Options
-        -> Cradle
-        -> CabalConfig
-        -> m ()
-initializeFlagsWithCradle opt c config
-  | cabal     = withCabal
-  | otherwise = withSandbox
-  where
-    mCabalFile = cradleCabalFile c
+withCradle :: IOish m => FilePath -> (Cradle -> m a) -> m a
+withCradle cradledir f =
+    gbracket (liftIO $ findCradle' cradledir) (liftIO . cleanupCradle) f

-    cabal = isJust mCabalFile
+withGhcModEnv :: IOish m => FilePath -> Options -> (GhcModEnv -> m a) -> m a
+withGhcModEnv dir opt f = withCradle dir (withGhcModEnv' opt f)

-    ghcopts = ghcUserOptions opt
-
-    withCabal = do
-        let Just cabalFile = mCabalFile
-        pkgDesc <- parseCabalFile config cabalFile
-        compOpts <- getCompilerOptions ghcopts c config pkgDesc
-        initSession CabalPkg opt compOpts
-
-    withSandbox = initSession SingleFile opt compOpts
-      where
-        importDirs = [".","..","../..","../../..","../../../..","../../../../.."]
-
-        pkgOpts = ghcDbStackOpts $ cradlePkgDbStack c
-
-        compOpts
-          | null pkgOpts = CompilerOptions ghcopts importDirs []
-          | otherwise    = CompilerOptions (ghcopts ++ pkgOpts) [wdir,rdir] []
-
-        (wdir, rdir) = (cradleCurrentDir c, cradleRootDir c)
-
-initSession :: GhcMonad m
-            => Build
-            -> Options
-            -> CompilerOptions
-            -> m ()
-initSession build Options {..} CompilerOptions {..} = do
-    df <- G.getSessionDynFlags
-    void $ G.setSessionDynFlags =<< addCmdOpts ghcOptions
-      ( setModeSimple
-      $ Gap.setFlags
-      $ setIncludeDirs includeDirs
-      $ setBuildEnv build
-      $ setEmptyLogger
-      $ Gap.addPackageFlags depPackages df)
-
----------------------------------------------------------------
-
-newGhcModEnv :: Options -> FilePath -> IO GhcModEnv
-newGhcModEnv opt dir = do
-      session <- newIORef (error "empty session")
-      c <- findCradle' dir
-      return GhcModEnv {
-          gmGhcSession = session
-        , gmOptions = opt
-        , gmCradle = c
-        }
-
-cleanupGhcModEnv :: GhcModEnv -> IO ()
-cleanupGhcModEnv env = cleanupCradle $ gmCradle env
+withGhcModEnv' :: IOish m => Options -> (GhcModEnv -> m a) -> Cradle -> m a
+withGhcModEnv' opt f crdl = do
+    olddir <- liftIO getCurrentDirectory
+    gbracket_ (liftIO $ setCurrentDirectory $ cradleRootDir crdl)
+              (liftIO $ setCurrentDirectory olddir)
+              (f $ GhcModEnv opt crdl)
+ where
+   gbracket_ ma mb mc = gbracket ma (const mb) (const mc)

 -- | Run a @GhcModT m@ computation.
 runGhcModT :: IOish m
           => Options
           -> GhcModT m a
           -> m (Either GhcModError a, GhcModLog)
-runGhcModT opt action = gbracket newEnv delEnv $ \env -> do
-    r <- first (fst <$>) <$> (runGhcModT' env defaultState $ do
-        dflags <- getSessionDynFlags
-        defaultCleanupHandler dflags $ do
-            config <- cabalGetConfig =<< cradle
-            initializeFlagsWithCradle opt (gmCradle env) config
-            action )
-    return r
+runGhcModT opt action = do
+    dir <- liftIO getCurrentDirectory
+    runGhcModT' dir opt action

- where
-   newEnv = liftBase $ newGhcModEnv opt =<< getCurrentDirectory
-   delEnv = liftBase . cleanupGhcModEnv
+runGhcModT' :: IOish m
+            => FilePath
+            -> Options
+            -> GhcModT m a
+            -> m (Either GhcModError a, GhcModLog)
+runGhcModT' dir opt action = liftIO (canonicalizePath dir) >>= \dir' ->
+    withGhcModEnv dir' opt $ \env ->
+      first (fst <$>) <$> runGhcModT'' env defaultGhcModState
+        (gmSetLogLevel (logLevel opt) >> action)

 -- | @hoistGhcModT result@. Embed a GhcModT computation's result into a GhcModT
 -- computation. Note that if the computation that returned @result@ modified the
@ -182,7 +89,7 @@ hoistGhcModT :: IOish m
             => (Either GhcModError a, GhcModLog)
             -> GhcModT m a
 hoistGhcModT (r,l) = do
-  gmJournal l >> case r of
+  gmlJournal l >> case r of
    Left e -> throwError e
    Right a -> return a

@ -191,57 +98,10 @@ hoistGhcModT (r,l) = do
 -- do with 'GhcModEnv' and 'GhcModState'.
 --
 -- You should probably look at 'runGhcModT' instead.
-runGhcModT' :: IOish m
-           => GhcModEnv
-           -> GhcModState
-           -> GhcModT m a
-           -> m (Either GhcModError (a, GhcModState), GhcModLog)
-runGhcModT' r s a = do
-  (res, w') <-
-      flip runReaderT r $ runJournalT $ runErrorT $
-        runStateT (unGhcModT $ initGhcMonad (Just libdir) >> a) s
-  return (res, w')
----------------------------------------------------------------
-- | Make a copy of the 'gmGhcSession' IORef, run the action and restore the
-- original 'HscEnv'.
-withTempSession :: IOish m => GhcModT m a -> GhcModT m a
-withTempSession action = do
-  session <- gmGhcSession <$> ask
-  savedHscEnv <- liftIO $ readIORef session
-  a <- action
-  liftIO $ writeIORef session savedHscEnv
-  return a
-
----------------------------------------------------------------
-
-gmeAsk :: IOish m => GhcModT m GhcModEnv
-gmeAsk = ask
-
-gmsGet :: IOish m => GhcModT m GhcModState
-gmsGet = GhcModT get
-
-gmsPut :: IOish m => GhcModState -> GhcModT m ()
-gmsPut = GhcModT . put
-
-options :: IOish m => GhcModT m Options
-options = gmOptions <$> gmeAsk
-
-cradle :: IOish m => GhcModT m Cradle
-cradle = gmCradle <$> gmeAsk
-
-getCompilerMode :: IOish m => GhcModT m CompilerMode
-getCompilerMode = gmCompilerMode <$> gmsGet
-
-setCompilerMode :: IOish m => CompilerMode -> GhcModT m ()
-setCompilerMode mode = (\s -> gmsPut s { gmCompilerMode = mode } ) =<< gmsGet
-
----------------------------------------------------------------
-
-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
-
----------------------------------------------------------------
+runGhcModT'' :: IOish m
+             => GhcModEnv
+             -> GhcModState
+             -> GhcModT m a
+             -> m (Either GhcModError (a, GhcModState), GhcModLog)
+runGhcModT'' r s a = do
+  flip runReaderT r $ runJournalT $ runErrorT $ runStateT (unGhcModT a) s
--- a/Language/Haskell/GhcMod/Monad/Types.hs
+++ b/Language/Haskell/GhcMod/Monad/Types.hs
@ -16,13 +16,45 @@

 {-# LANGUAGE CPP, GeneralizedNewtypeDeriving, FlexibleInstances #-}
 {-# LANGUAGE FlexibleContexts, MultiParamTypeClasses, RankNTypes #-}
-{-# LANGUAGE TypeFamilies, UndecidableInstances, RecordWildCards #-}
-{-# LANGUAGE ScopedTypeVariables, BangPatterns #-}
+{-# LANGUAGE TypeFamilies, UndecidableInstances, BangPatterns #-}
+{-# LANGUAGE StandaloneDeriving, InstanceSigs #-}
 {-# OPTIONS_GHC -fno-warn-orphans #-}

-module Language.Haskell.GhcMod.Monad.Types where
-
+module Language.Haskell.GhcMod.Monad.Types (
+  -- * Monad Types
+    GhcModT(..)
+  , GmLoadedT(..)
+  , LightGhc(..)
+  , GmGhc
+  , IOish
+  -- ** Environment, state and logging
+  , GhcModEnv(..)
+  , GhcModState(..)
+  , defaultGhcModState
+  , GmGhcSession(..)
+  , GmComponent(..)
+  , CompilerMode(..)
+  -- ** Accessing 'GhcModEnv', 'GhcModState' and 'GhcModLog'
+  , GmLogLevel(..)
+  , GhcModLog(..)
+  , GhcModError(..)
+  , GmEnv(..)
+  , GmState(..)
+  , GmLog(..)
+  , cradle
+  , options
+  , withOptions
+  , getCompilerMode
+  , setCompilerMode
+  -- ** Re-exporting convenient stuff
+  , MonadIO
+  , liftIO
+  ) where

+-- MonadUtils of GHC 7.6 or earlier defines its own MonadIO.
+-- RWST does not automatically become an instance of MonadIO.
+-- MonadUtils of GHC 7.8 or later imports MonadIO in Monad.Control.IO.Class.
+-- So, RWST automatically becomes an instance of
 #if __GLASGOW_HASKELL__ < 708
 -- 'CoreMonad.MonadIO' and 'Control.Monad.IO.Class.MonadIO' are different
 -- classes before ghc 7.8
@ -33,37 +65,28 @@ module Language.Haskell.GhcMod.Monad.Types where
 #endif

 import Language.Haskell.GhcMod.Types
-import Language.Haskell.GhcMod.Error

 import GHC
 import DynFlags
-import GhcMonad hiding (withTempSession)
-#if __GLASGOW_HASKELL__ <= 702
+import Exception
 import HscTypes
-#endif

-- MonadUtils of GHC 7.6 or earlier defines its own MonadIO.
-- RWST does not automatically become an instance of MonadIO.
-- MonadUtils of GHC 7.8 or later imports MonadIO in Monad.Control.IO.Class.
-- So, RWST automatically becomes an instance of MonadIO.
-import MonadUtils
+import Control.Applicative (Applicative, Alternative, (<$>))
+import Control.Monad

-import Control.Applicative (Alternative)
-import Control.Monad (MonadPlus)
-import Control.Monad.Error (ErrorT)
-import Control.Monad.Reader (ReaderT)
-import Control.Monad.State.Strict (StateT)
+import Control.Monad.Reader (ReaderT(..))
+import Control.Monad.Error (ErrorT(..), MonadError(..))
+import Control.Monad.State.Strict (StateT(..))
 import Control.Monad.Trans.Journal (JournalT)

-import Control.Monad.Base (MonadBase, liftBase)
-import Control.Monad.Trans.Control (MonadBaseControl(..), StM, liftBaseWith,
-  control, liftBaseOp, liftBaseOp_)
+import Control.Monad.Base (MonadBase(..), liftBase)
+import Control.Monad.Trans.Control

-import Control.Monad.Trans.Class
 import Control.Monad.Reader.Class
-import Control.Monad.Writer.Class (MonadWriter)
+import Control.Monad.Writer.Class
 import Control.Monad.State.Class (MonadState(..))
 import Control.Monad.Journal.Class (MonadJournal(..))
+import Control.Monad.Trans.Class (MonadTrans(..))

 #ifdef MONADIO_INSTANCES
 import Control.Monad.Trans.Maybe (MaybeT)
@ -71,41 +94,49 @@ import Control.Monad.Error (Error(..))
 #endif

 #if DIFFERENT_MONADIO
-import Control.Monad.Trans.Class (lift)
 import qualified Control.Monad.IO.Class
 import Data.Monoid (Monoid)
 #endif

-#if !MIN_VERSION_monad_control(1,0,0)
-import Control.Monad (liftM)
-#endif
-
+import Data.Set (Set)
+import Data.Map (Map, empty)
+import Data.Maybe
 import Data.Monoid
 import Data.IORef

+import MonadUtils (MonadIO(..))
+
 data GhcModEnv = GhcModEnv {
-      gmGhcSession :: !(IORef HscEnv)
-    , gmOptions    :: Options
+      gmOptions    :: Options
    , gmCradle     :: Cradle
    }

 data GhcModLog = GhcModLog {
-      gmLogMessages :: [String]
+      gmLogLevel    :: Maybe GmLogLevel,
+      gmLogMessages :: [(GmLogLevel, String, String)]
    } deriving (Eq, Show, Read)

 instance Monoid GhcModLog where
-    mempty = GhcModLog mempty
-    GhcModLog a `mappend` GhcModLog b = GhcModLog (a `mappend` b)
+    mempty = GhcModLog (Just GmPanic) mempty
+    GhcModLog ml a `mappend` GhcModLog ml' b =
+        GhcModLog (ml' `mplus` ml) (a `mappend` b)
+
+data GmGhcSession = GmGhcSession {
+      gmgsOptions :: ![GHCOption],
+      gmgsSession :: !(IORef HscEnv)
+    }

 data GhcModState = GhcModState {
-      gmCompilerMode :: CompilerMode
-    } deriving (Eq,Show,Read)
+      gmGhcSession   :: !(Maybe GmGhcSession)
+    , gmComponents   :: !(Map GmComponentName (GmComponent (Set ModulePath)))
+    , gmCompilerMode :: !CompilerMode
+    }
+
+defaultGhcModState :: GhcModState
+defaultGhcModState = GhcModState Nothing empty Simple

 data CompilerMode = Simple | Intelligent deriving (Eq,Show,Read)

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

 -- | This is basically a newtype wrapper around 'StateT', 'ErrorT', 'JournalT'
@ -130,39 +161,111 @@ newtype GhcModT m a = GhcModT {
 #if DIFFERENT_MONADIO
               , Control.Monad.IO.Class.MonadIO
 #endif
-               , MonadReader GhcModEnv -- TODO: make MonadReader instance
-                                       -- pass-through like MonadState
-               , MonadWriter w
               , MonadError GhcModError
               )

+newtype GmLoadedT m a = GmLoadedT { unGmLoadedT :: GhcModT m a }
+    deriving ( Functor
+             , Applicative
+             , Alternative
+             , Monad
+             , MonadPlus
+             , MonadTrans
+             , MonadIO
+#if DIFFERENT_MONADIO
+             , Control.Monad.IO.Class.MonadIO
+#endif
+             , MonadError GhcModError
+             , GmEnv
+             , GmState
+             , GmLog
+             )
+
+newtype LightGhc a = LightGhc { unLightGhc :: ReaderT (IORef HscEnv) IO a }
+    deriving ( Functor
+             , Applicative
+             , Monad
+             , MonadIO
+#if DIFFERENT_MONADIO
+             , Control.Monad.IO.Class.MonadIO
+#endif
+             )
+
+
+class Monad m => GmEnv m where
+    gmeAsk :: m GhcModEnv
+    gmeAsk = gmeReader id
+
+    gmeReader :: (GhcModEnv -> a) -> m a
+    gmeReader f = f `liftM` gmeAsk
+
+    gmeLocal :: (GhcModEnv -> GhcModEnv) -> m a -> m a
+    {-# MINIMAL (gmeAsk | gmeReader), gmeLocal #-}
+
+instance Monad m => GmEnv (GhcModT m) where
+    gmeAsk = GhcModT ask
+    gmeReader = GhcModT . reader
+    gmeLocal f a = GhcModT $ local f (unGhcModT a)
+
+instance GmEnv m => GmEnv (StateT s m) where
+    gmeAsk = lift gmeAsk
+    gmeReader = lift . gmeReader
+    gmeLocal f (StateT a) = StateT $ \s -> gmeLocal f (a s)
+
+class Monad m => GmState m where
+    gmsGet :: m GhcModState
+    gmsGet = gmsState (\s -> (s, s))
+
+    gmsPut :: GhcModState -> m ()
+    gmsPut s = gmsState (\_ -> ((), s))
+
+    gmsState :: (GhcModState -> (a, GhcModState)) -> m a
+    gmsState f = do
+      s <- gmsGet
+      let ~(a, s') = f s
+      gmsPut s'
+      return a
+    {-# MINIMAL gmsState | gmsGet, gmsPut #-}
+
+instance Monad m => GmState (StateT GhcModState m) where
+    gmsGet = get
+    gmsPut = put
+    gmsState = state
+
+instance Monad m => GmState (GhcModT m) where
+    gmsGet = GhcModT get
+    gmsPut = GhcModT . put
+    gmsState = GhcModT . state
+
+class Monad m => GmLog m where
+    gmlJournal :: GhcModLog -> m ()
+    gmlHistory :: m GhcModLog
+    gmlClear   :: m ()
+
+instance Monad m => GmLog (JournalT GhcModLog m) where
+    gmlJournal = journal
+    gmlHistory = history
+    gmlClear   = clear
+
+instance Monad m => GmLog (GhcModT m) where
+    gmlJournal = GhcModT . lift . lift . journal
+    gmlHistory = GhcModT $ lift $ lift history
+    gmlClear   = GhcModT $ lift $ lift clear
+
+instance (Monad m, GmLog m) => GmLog (ReaderT r m) where
+    gmlJournal = lift . gmlJournal
+    gmlHistory = lift gmlHistory
+    gmlClear = lift  gmlClear
+
+instance (Monad m, GmLog m) => GmLog (StateT s m) where
+    gmlJournal = lift . gmlJournal
+    gmlHistory = lift gmlHistory
+    gmlClear = lift gmlClear
+
 instance MonadIO m => MonadIO (GhcModT m) where
-    liftIO action = do
-      res <- GhcModT . liftIO . liftIO . liftIO . liftIO $ try action
-      case res of
-        Right a -> return a
+    liftIO action = GhcModT $ liftIO action

-        Left e | isIOError e ->
-                   throwError $ GMEIOException (fromEx e :: IOError)
-        Left e | isGhcModError e ->
-                   throwError $ (fromEx e :: GhcModError)
-        Left e -> throw e
-
-     where
-       fromEx :: Exception e => SomeException -> e
-       fromEx se = let Just e = fromException se in e
-
-       isIOError se =
-           case fromException se of
-             Just (_ :: IOError) -> True
-             Nothing -> False
-
-       isGhcModError se =
-           case fromException se of
-             Just (_ :: GhcModError) -> True
-             Nothing -> False
-
-instance (Monad m) => MonadJournal GhcModLog (GhcModT m) where
+instance Monad m => MonadJournal GhcModLog (GhcModT m) where
  journal !w = GhcModT $ lift $ lift $ (journal w)
  history    = GhcModT $ lift $ lift $ history
  clear      = GhcModT $ lift $ lift $ clear
@ -170,6 +273,18 @@ instance (Monad m) => MonadJournal GhcModLog (GhcModT m) where
 instance MonadTrans GhcModT where
    lift = GhcModT . lift . lift . lift . lift

+instance forall r m. MonadReader r m => MonadReader r (GhcModT m) where
+    local f ma = gmLiftWithInner (\run -> local f (run ma))
+    ask = gmLiftInner ask
+
+instance (Monoid w, MonadWriter w m) => MonadWriter w (GhcModT m) where
+    tell = gmLiftInner . tell
+    listen ma =
+      liftWith (\run -> listen (run ma)) >>= \(sta, w) ->
+          flip (,) w `liftM` restoreT (return sta)
+
+    pass maww = maww >>= gmLiftInner . pass . return
+
 instance MonadState s m => MonadState s (GhcModT m) where
    get = GhcModT $ lift $ lift $ lift get
    put = GhcModT . lift . lift . lift . put
@ -192,12 +307,24 @@ instance MonadIO m => MonadIO (MaybeT m) where
    liftIO = lift . liftIO
 #endif

+instance (MonadBaseControl IO m) => MonadBase IO (GmLoadedT m) where
+    liftBase = GmLoadedT . liftBase
+
+instance (MonadBaseControl IO m) => MonadBaseControl IO (GmLoadedT m) where
+    type StM (GmLoadedT m) a = StM (GhcModT m) a
+    liftBaseWith = defaultLiftBaseWith
+    restoreM = defaultRestoreM
+    {-# INLINE liftBaseWith #-}
+    {-# INLINE restoreM #-}
+
+instance MonadTransControl GmLoadedT where
+    type StT GmLoadedT a = StT GhcModT a
+    liftWith = defaultLiftWith GmLoadedT unGmLoadedT
+    restoreT = defaultRestoreT GmLoadedT

 instance (MonadBaseControl IO m) => MonadBase IO (GhcModT m) where
    liftBase = GhcModT . liftBase

-#if MIN_VERSION_monad_control(1,0,0)
-
 instance (MonadBaseControl IO m) => MonadBaseControl IO (GhcModT m) where
    type StM (GhcModT m) a =
          StM (StateT GhcModState
@ -211,94 +338,109 @@ instance (MonadBaseControl IO m) => MonadBaseControl IO (GhcModT m) where
    {-# INLINE liftBaseWith #-}
    {-# INLINE restoreM #-}

-#else
+instance MonadTransControl GhcModT where
+    type StT GhcModT a = (Either GhcModError (a, GhcModState), GhcModLog)

-instance (MonadBaseControl IO m) => MonadBaseControl IO (GhcModT m) where
-    newtype StM (GhcModT m) a = StGhcMod {
-          unStGhcMod :: StM (StateT GhcModState
-                              (ErrorT GhcModError
-                                (JournalT GhcModLog
-                                  (ReaderT GhcModEnv m) ) ) ) a }
-    liftBaseWith f = GhcModT . liftBaseWith $ \runInBase ->
-        f $ liftM StGhcMod . runInBase . unGhcModT
+    liftWith f = GhcModT $
+      liftWith $ \runS ->
+        liftWith $ \runE ->
+          liftWith $ \runJ ->
+            liftWith $ \runR ->
+              f $ \ma -> runR $ runJ $ runE $ runS $ unGhcModT ma
+    restoreT = GhcModT . restoreT . restoreT . restoreT . restoreT
+    {-# INLINE liftWith #-}
+    {-# INLINE restoreT #-}

-    restoreM = GhcModT . restoreM . unStGhcMod
-    {-# INLINE liftBaseWith #-}
-    {-# INLINE restoreM #-}
+gmLiftInner :: Monad m => m a -> GhcModT m a
+gmLiftInner = GhcModT . lift . lift . lift . lift

-#endif
+gmLiftWithInner :: (MonadTransControl t, Monad m, Monad (t m))
+                => (Run t -> m (StT t a)) -> t m a
+gmLiftWithInner f = liftWith f >>= restoreT . return

 -- GHC cannot prove the following instances to be decidable automatically using
 -- the FlexibleContexts extension as they violate the second Paterson Condition,
 -- namely that: The assertion has fewer constructors and variables (taken
 -- together and counting repetitions) than the head. Specifically the
-- @MonadBaseControl IO m@ constraint is causing this violation.
--
-- Proof of termination:
--
-- Assuming all constraints containing the variable `m' exist and are decidable
-- we show termination by manually replacing the current set of constraints with
-- their own set of constraints and show that this, after a finite number of
-- steps, results in the empty set, i.e. not having to check any more
-- constraints.
--
-- We start by setting the constraints to be those immediate constraints of the
-- instance declaration which cannot be proven decidable automatically for the
-- type under consideration.
--
-- @
-- { MonadBaseControl IO m }
-- @
--
-- Classes used:
--
-- * @class MonadBase b m => MonadBaseControl b m@
--
-- @
-- { MonadBase IO m }
-- @
--
-- Classes used:
--
-- * @class (Applicative b, Applicative m, Monad b, Monad m) => MonadBase b m@
--
-- @
-- { Applicative IO, Applicative m, Monad IO, Monad m }
-- @
--
-- Classes used:
--
-- * @class Monad m@
-- * @class Applicative f => Functor f@
--
-- @
-- { Functor m }
-- @
--
-- Classes used:
--
-- * @class Functor f@
--
-- @
-- { }
-- @
-- ∎
+-- @MonadBaseControl IO m@ constraint in 'IOish' is causing this violation.

-instance (Functor m, MonadIO m, MonadBaseControl IO m)
-      => GhcMonad (GhcModT m) where
-    getSession = (liftIO . readIORef) . gmGhcSession =<< ask
-    setSession a = (liftIO . flip writeIORef a) . gmGhcSession =<< ask
+type GmGhc m = (IOish m, GhcMonad m)
+
+instance (MonadIO m, MonadBaseControl IO m) => GhcMonad (GmLoadedT m) where
+    getSession = do
+        ref <- gmgsSession . fromJust . gmGhcSession <$> gmsGet
+        liftIO $ readIORef ref
+    setSession a = do
+        ref <- gmgsSession . fromJust . gmGhcSession <$> gmsGet
+        liftIO $ flip writeIORef a ref
+
+instance GhcMonad LightGhc where
+    getSession = (liftIO . readIORef) =<< LightGhc ask
+    setSession a = (liftIO . flip writeIORef a) =<< LightGhc ask

 #if __GLASGOW_HASKELL__ >= 706
-instance (Functor m, MonadIO m, MonadBaseControl IO m)
-      => HasDynFlags (GhcModT m) where
-    getDynFlags = getSessionDynFlags
+instance (MonadIO m, MonadBaseControl IO m) => HasDynFlags (GmLoadedT m) where
+    getDynFlags = hsc_dflags <$> getSession
+
+instance HasDynFlags LightGhc where
+    getDynFlags = hsc_dflags <$> getSession
 #endif

-instance (MonadIO m, MonadBaseControl IO m)
-      => ExceptionMonad (GhcModT m) where
+instance (MonadIO m, MonadBaseControl IO m) => ExceptionMonad (GhcModT m) where
    gcatch act handler = control $ \run ->
        run act `gcatch` (run . handler)

    gmask = liftBaseOp gmask . liftRestore
     where liftRestore f r = f $ liftBaseOp_ r
+
+instance (MonadIO m, MonadBaseControl IO m) => ExceptionMonad (GmLoadedT m) where
+    gcatch act handler = control $ \run ->
+        run act `gcatch` (run . handler)
+
+    gmask = liftBaseOp gmask . liftRestore
+     where liftRestore f r = f $ liftBaseOp_ r
+
+instance ExceptionMonad LightGhc where
+  gcatch act handl =
+      LightGhc $ unLightGhc act `gcatch` \e -> unLightGhc (handl e)
+  gmask f =
+      LightGhc $ gmask $ \io_restore ->let
+          g_restore (LightGhc m) = LightGhc $ io_restore m
+      in
+        unLightGhc (f g_restore)
+
+
+instance (MonadIO m, MonadBaseControl IO m) => ExceptionMonad (StateT s m) where
+    gcatch act handler = control $ \run ->
+        run act `gcatch` (run . handler)
+
+    gmask = liftBaseOp gmask . liftRestore
+     where liftRestore f r = f $ liftBaseOp_ r
+
+instance (MonadIO m, MonadBaseControl IO m) => ExceptionMonad (ReaderT s m) where
+    gcatch act handler = control $ \run ->
+        run act `gcatch` (run . handler)
+
+    gmask = liftBaseOp gmask . liftRestore
+     where liftRestore f r = f $ liftBaseOp_ r
+
+----------------------------------------------------------------
+
+options :: GmEnv m => m Options
+options = gmOptions `liftM` gmeAsk
+
+cradle :: GmEnv m => m Cradle
+cradle = gmCradle `liftM` gmeAsk
+
+getCompilerMode :: GmState m => m CompilerMode
+getCompilerMode = gmCompilerMode `liftM` gmsGet
+
+setCompilerMode :: GmState m => CompilerMode -> m ()
+setCompilerMode mode = (\s -> gmsPut s { gmCompilerMode = mode } ) =<< gmsGet
+
+withOptions :: GmEnv m => (Options -> Options) -> m a -> m a
+withOptions changeOpt action = gmeLocal changeEnv action
+  where
+    changeEnv e = e { gmOptions = changeOpt opt }
+      where
+        opt = gmOptions e
--- a/Language/Haskell/GhcMod/PathsAndFiles.hs
+++ b/Language/Haskell/GhcMod/PathsAndFiles.hs
@ -1,4 +1,3 @@
-{-# LANGUAGE BangPatterns, TupleSections #-}
 -- ghc-mod: Making Haskell development *more* fun
 -- Copyright (C) 2015  Daniel Gröber <dxld ÄT darkboxed DOT org>
 --
@ -20,28 +19,79 @@ module Language.Haskell.GhcMod.PathsAndFiles where
 import Config (cProjectVersion)
 import Control.Applicative
 import Control.Monad
+import Control.Monad.Trans.Maybe
 import Data.List
 import Data.Char
 import Data.Maybe
 import Data.Traversable (traverse)
-import Distribution.System (buildPlatform)
-import Distribution.Text (display)
-import Language.Haskell.GhcMod.Types
+import Types
 import System.Directory
 import System.FilePath
+import System.IO.Unsafe

+import Language.Haskell.GhcMod.Types
 import Language.Haskell.GhcMod.Error
+import Language.Haskell.GhcMod.Read
+import Language.Haskell.GhcMod.Utils hiding (dropWhileEnd)
 import qualified Language.Haskell.GhcMod.Utils as U

-import Distribution.Simple.BuildPaths (defaultDistPref)
-import Distribution.Simple.Configure (localBuildInfoFile)
-
 -- | Guaranteed to be a path to a directory with no trailing slash.
 type DirPath = FilePath

 -- | Guaranteed to be the name of a file only (no slashes).
 type FileName = String

+data Cached d a = Cached {
+      inputFiles :: [FilePath],
+      inputData  :: d,
+      cacheFile  :: FilePath
+    }
+
+newtype UnString = UnString { unString :: String }
+
+instance Show UnString where
+    show = unString
+
+instance Read UnString where
+    readsPrec _ = \str -> [(UnString str, "")]
+
+-- |
+--
+-- >>> any (Just 3 <) [Just 1, Nothing, Just 2]
+-- False
+--
+-- >>> any (Just 0 <) [Just 1, Nothing, Just 2]
+-- True
+--
+-- >>> any (Just 0 <) [Nothing]
+-- False
+--
+-- >>> any (Just 0 <) []
+-- False
+cached :: forall a d. (Read a, Show a, Eq d, Read d, Show d)
+       => DirPath -> Cached d a -> IO a -> IO a
+cached dir Cached {..} ma = do
+    ins <- (maybeTimeFile . (dir </>)) `mapM` inputFiles
+    c <- maybeTimeFile (dir </> cacheFile)
+    if any (c<) ins || isNothing c
+       then writeCache
+       else maybe ma return =<< readCache
+ where
+   maybeTimeFile :: FilePath -> IO (Maybe TimedFile)
+   maybeTimeFile f = traverse timeFile =<< mightExist f
+
+   writeCache = do
+     a <- ma
+     writeFile (dir </> cacheFile) $ unlines [show inputData, show a]
+     return a
+
+   readCache :: IO (Maybe a)
+   readCache = runMaybeT $ do
+     hdr:c:_ <- lines <$> liftIO (readFile $ dir </> cacheFile)
+     if inputData /= read hdr
+       then liftIO $ writeCache
+       else MaybeT $ return $ readMaybe c
+
 -- | @findCabalFiles dir@. Searches for a @.cabal@ files in @dir@'s parent
 -- directories. The first parent directory containing more than one cabal file
 -- is assumed to be the project directory. If only one cabal file exists in this
@ -49,13 +99,17 @@ type FileName = String
 -- or 'GMETooManyCabalFiles'
 findCabalFile :: FilePath -> IO (Maybe FilePath)
 findCabalFile dir = do
-    dcs <- findFileInParentsP  isCabalFile dir
-    -- Extract first non-empty list, which represents a directory with cabal
-    -- files.
-    case find (not . null) $ uncurry appendDir `map` dcs of
-      Just []          -> throw $ GMENoCabalFile
+    -- List of directories and all cabal file candidates
+    dcs <- findFileInParentsP  isCabalFile dir :: IO ([(DirPath, [FileName])])
+    let css = uncurry appendDir `map` dcs :: [[FilePath]]
+    case find (not . null) css of
+      Nothing -> return Nothing
      Just cfs@(_:_:_) -> throw $ GMETooManyCabalFiles cfs
-      a  -> return $ head <$> a
+      Just (a:_)       -> return (Just a)
+      Just []          -> error "findCabalFile"
+ where
+   appendDir :: DirPath -> [FileName] -> [FilePath]
+   appendDir d fs = (d </>) `map` fs

 -- |
 -- >>> isCabalFile "/home/user/.cabal"
@ -105,11 +159,8 @@ findCabalSandboxDir dir = do
 where
   isSandboxConfig = (=="cabal.sandbox.config")

-appendDir :: DirPath -> [FileName] -> [FilePath]
-appendDir d fs = (d </>) `map` fs
-
 zipMapM :: Monad m => (a -> m c) -> [a] -> m [(a,c)]
-zipMapM f as = mapM (\a -> liftM (a,) $ f a) as
+zipMapM f as = mapM (\a -> liftM ((,) a) $ f a) as

 -- | @parents dir@. Returns all parent directories of @dir@ including @dir@.
 --
@ -169,24 +220,29 @@ setupConfigFile crdl = cradleRootDir crdl </> setupConfigPath

 -- | Path to 'LocalBuildInfo' file, usually @dist/setup-config@
 setupConfigPath :: FilePath
-setupConfigPath = localBuildInfoFile defaultDistPref
+setupConfigPath = "dist/setup-config" -- localBuildInfoFile defaultDistPref

 ghcSandboxPkgDbDir :: String
 ghcSandboxPkgDbDir =
-   targetPlatform ++ "-ghc-" ++ cProjectVersion ++ "-packages.conf.d"
-  where
-    targetPlatform = display buildPlatform
+   cabalBuildPlatform ++ "-ghc-" ++ cProjectVersion ++ "-packages.conf.d"
+
+cabalBuildPlatform :: String
+cabalBuildPlatform = dropWhileEnd isSpace $ unsafePerformIO $
+    readLibExecProcess' "cabal-helper-wrapper" ["print-build-platform"]

 packageCache :: String
 packageCache = "package.cache"

-- | Filename of the show'ed Cabal setup-config cache
-prettyConfigCache :: FilePath
-prettyConfigCache = setupConfigPath <.> "ghc-mod-0.pretty-cabal-cache"
+cabalHelperCache :: [String] -> Cached [String] [Maybe GmCabalHelperResponse]
+cabalHelperCache cmds = Cached {
+    inputFiles = [setupConfigPath],
+    inputData  = cmds,
+    cacheFile  = setupConfigPath <.> "ghc-mod.cabal-helper"
+  }

 -- | Filename of the symbol table cache file.
 symbolCache :: Cradle -> FilePath
 symbolCache crdl = cradleTempDir crdl </> symbolCacheFile

 symbolCacheFile :: String
-symbolCacheFile = "ghc-mod-0.symbol-cache"
+symbolCacheFile = "ghc-mod.symbol-cache"
--- a/Language/Haskell/GhcMod/PkgDoc.hs
+++ b/Language/Haskell/GhcMod/PkgDoc.hs
@ -11,11 +11,11 @@ import Control.Applicative ((<$>))
 pkgDoc :: IOish m => String -> GhcModT m String
 pkgDoc mdl = do
    c <- cradle
-    pkg <- trim <$> readProcess' "ghc-pkg" (toModuleOpts c)
+    pkg <- liftIO $ trim <$> readProcess "ghc-pkg" (toModuleOpts c) ""
    if pkg == "" then
        return "\n"
      else do
-        htmlpath <- readProcess' "ghc-pkg" (toDocDirOpts pkg c)
+        htmlpath <- liftIO $ readProcess "ghc-pkg" (toDocDirOpts pkg c) ""
        let ret = pkg ++ " " ++ drop 14 htmlpath
        return ret
  where
--- a/Language/Haskell/GhcMod/Pretty.hs
+++ b/Language/Haskell/GhcMod/Pretty.hs
@ -0,0 +1,64 @@
+-- ghc-mod: Making Haskell development *more* fun
+-- Copyright (C) 2015  Daniel Gröber <dxld ÄT darkboxed DOT org>
+--
+-- This program is free software: you can redistribute it and/or modify
+-- it under the terms of the GNU Affero General Public License as published by
+-- the Free Software Foundation, either version 3 of the License, or
+-- (at your option) any later version.
+--
+-- This program is distributed in the hope that it will be useful,
+-- but WITHOUT ANY WARRANTY; without even the implied warranty of
+-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+-- GNU Affero General Public License for more details.
+--
+-- You should have received a copy of the GNU Affero General Public License
+-- along with this program.  If not, see <http://www.gnu.org/licenses/>.
+
+module Language.Haskell.GhcMod.Pretty where
+
+import Control.Arrow hiding ((<+>))
+import Text.PrettyPrint
+
+import Language.Haskell.GhcMod.Types
+
+docStyle :: Style
+docStyle = style { ribbonsPerLine = 1.2 }
+
+gmRenderDoc :: Doc -> String
+gmRenderDoc = renderStyle docStyle
+
+gmComponentNameDoc :: GmComponentName -> Doc
+gmComponentNameDoc GmSetupHsName   = text $ "Setup.hs"
+gmComponentNameDoc GmLibName       = text $ "library"
+gmComponentNameDoc (GmExeName n)   = text $ "exe:" ++ n
+gmComponentNameDoc (GmTestName n)  = text $ "test:" ++ n
+gmComponentNameDoc (GmBenchName n) = text $ "bench:" ++ n
+
+gmLogLevelDoc :: GmLogLevel -> Doc
+gmLogLevelDoc GmPanic     = text "PANIC"
+gmLogLevelDoc GmException = text "EXCEPTION"
+gmLogLevelDoc GmError     = text "ERROR"
+gmLogLevelDoc GmWarning   = text "Warning"
+gmLogLevelDoc GmInfo      = text "info"
+gmLogLevelDoc GmDebug     = text "DEBUG"
+
+infixl 6 <+>:
+(<+>:) :: Doc -> Doc -> Doc
+a <+>: b = (a <> colon) <+> b
+
+fnDoc :: FilePath -> Doc
+fnDoc = doubleQuotes . text
+
+showDoc :: Show a => a -> Doc
+showDoc = text . show
+
+warnDoc :: Doc -> Doc
+warnDoc d = text "Warning" <+>: d
+
+strDoc :: String -> Doc
+strDoc str = doc str
+ where
+   doc :: String -> Doc
+   doc = lines
+         >>> map (words >>> map text >>> fsep)
+         >>> \l -> case l of (x:xs) -> hang x 4 (vcat xs); [] -> empty
--- a/Language/Haskell/GhcMod/SrcUtils.hs
+++ b/Language/Haskell/GhcMod/SrcUtils.hs
@ -13,12 +13,9 @@ 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 Language.Haskell.GhcMod.Doc
+import Language.Haskell.GhcMod.Gap
 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)
@ -83,22 +80,6 @@ typeSigInRangeHE _  _ _= False
 pretty :: DynFlags -> PprStyle -> Type -> String
 pretty dflag style = showOneLine dflag style . Gap.typeForUser

----------------------------------------------------------------
-
-inModuleContext :: IOish m
-                => FilePath
-                -> (DynFlags -> PprStyle -> GhcModT m a)
-                -> GhcModT m a
-inModuleContext file action =
-    withDynFlags (setWarnTypedHoles . setDeferTypeErrors . setNoWarningFlags) $ do
-    setTargetFiles [file]
-    Gap.withContext $ do
-        dflag <- G.getSessionDynFlags
-        style <- getStyle
-        action dflag style
-
----------------------------------------------------------------
-
 showName :: DynFlags -> PprStyle -> G.Name -> String
 showName dflag style name = showOneLine dflag style $ Gap.nameForUser name

--- a/Language/Haskell/GhcMod/Target.hs
+++ b/Language/Haskell/GhcMod/Target.hs
@ -1,7 +1,3 @@
-{-# LANGUAGE CPP #-}
-module Language.Haskell.GhcMod.Target (
-    setTargetFiles
-  ) where
 -- ghc-mod: Making Haskell development *more* fun
 -- Copyright (C) 2015  Daniel Gröber <dxld ÄT darkboxed DOT org>
 --
@ -18,56 +14,319 @@ module Language.Haskell.GhcMod.Target (
 -- You should have received a copy of the GNU Affero General Public License
 -- along with this program.  If not, see <http://www.gnu.org/licenses/>.

+{-# LANGUAGE CPP, ViewPatterns, NamedFieldPuns, RankNTypes #-}
+module Language.Haskell.GhcMod.Target where
+
+import Control.Arrow
 import Control.Applicative ((<$>))
-import Control.Monad (forM, void, (>=>))
-import DynFlags (ExtensionFlag(..), xopt)
-import GHC (LoadHowMuch(..))
-import qualified GHC as G
+import Control.Monad.Reader (runReaderT)
+import GHC
+import GHC.Paths (libdir)
+import StaticFlags
+import SysTools
+import DynFlags
+import HscMain
+import HscTypes
+
 import Language.Haskell.GhcMod.DynFlags
-import Language.Haskell.GhcMod.Monad
+import Language.Haskell.GhcMod.Monad.Types
+import Language.Haskell.GhcMod.CabalHelper
+import Language.Haskell.GhcMod.HomeModuleGraph
+import Language.Haskell.GhcMod.GhcPkg
+import Language.Haskell.GhcMod.Error
+import Language.Haskell.GhcMod.Logging
+import Language.Haskell.GhcMod.Types
+
+import Data.Maybe
+import Data.Either
+import Data.Foldable (foldrM)
+import Data.IORef
+import Data.Map.Strict (Map)
+import qualified Data.Map.Strict  as Map
+import Data.Set (Set)
+import qualified Data.Set as Set
+
+import System.Directory
+import System.FilePath
+
+withLightHscEnv :: forall m a. IOish m
+    => [GHCOption] -> (HscEnv -> m a) -> m a
+withLightHscEnv opts action = gbracket initEnv teardownEnv (action)
+
+ where
+   teardownEnv :: HscEnv -> m ()
+   teardownEnv env = liftIO $ do
+       let dflags = hsc_dflags env
+       cleanTempFiles dflags
+       cleanTempDirs dflags
+
+   initEnv :: m HscEnv
+   initEnv = liftIO $ do
+     initStaticOpts
+     settings <- initSysTools (Just libdir)
+     dflags  <- initDynFlags (defaultDynFlags settings)
+     env <- newHscEnv dflags
+     dflags' <- runLightGhc env $ do
+         -- HomeModuleGraph and probably all other clients get into all sorts of
+         -- trouble if the package state isn't initialized here
+         _ <- setSessionDynFlags =<< getSessionDynFlags
+         addCmdOpts opts =<< getSessionDynFlags
+     newHscEnv dflags'
+
+runLightGhc :: HscEnv -> LightGhc a -> IO a
+runLightGhc env action = do
+  renv <- newIORef env
+  flip runReaderT renv $ unLightGhc action
+
+runGmPkgGhc :: (IOish m, GmEnv m) => LightGhc a -> m a
+runGmPkgGhc action = do
+    pkgOpts <- packageGhcOptions
+    withLightHscEnv pkgOpts $ \env -> liftIO $ runLightGhc env action
+
+initSession :: IOish m
+            => [GHCOption] -> (DynFlags -> Ghc DynFlags) -> GhcModT m ()
+initSession opts mdf = do
+   s <- gmsGet
+   case gmGhcSession s of
+     Just GmGhcSession {..} -> do
+         if gmgsOptions == opts
+            then return ()
+            else error "TODO: reload stuff"
+     Nothing -> do
+       Cradle { cradleTempDir } <- cradle
+       ghc <- liftIO $ runGhc (Just libdir) $ do
+           let setDf df =
+                setTmpDir cradleTempDir <$> (mdf =<< addCmdOpts opts df)
+           _ <- setSessionDynFlags =<< setDf =<< getSessionDynFlags
+           getSession
+
+       rghc <- liftIO $ newIORef ghc
+       gmsPut s { gmGhcSession = Just $ GmGhcSession opts rghc }
+
+
+-- $ do
+--         dflags <- getSessionDynFlags
+--         defaultCleanupHandler dflags $ do
+--             initializeFlagsWithCradle opt (gmCradle env)
+--
+
+-- initSession :: GhcMonad m => Options -> [GHCOption] -> m ()
+-- initSession Options {..} ghcOpts = do
+--     df <- G.getSessionDynFlags
+--     void $
+--       ( setModeSimple -- $ setEmptyLogger
+--                       df)
+
+runGmLoadedT :: IOish m
+             => [Either FilePath ModuleName] -> GmLoadedT m a -> GhcModT m a
+runGmLoadedT fns action = runGmLoadedT' fns return action
+
+runGmLoadedT' :: IOish m
+              => [Either FilePath ModuleName]
+              -> (DynFlags -> Ghc DynFlags)
+              -> GmLoadedT m a
+              -> GhcModT m a
+runGmLoadedT' fns mdf action = runGmLoadedTWith fns mdf id action
+
+runGmLoadedTWith :: IOish m
+                 => [Either FilePath ModuleName]
+                 -> (DynFlags -> Ghc DynFlags)
+                 -> (GmLoadedT m a -> GmLoadedT m b)
+                 -> GmLoadedT m a
+                 -> GhcModT m b
+runGmLoadedTWith efnmns' mdf wrapper action = do
+    crdl <- cradle
+    Options { ghcUserOptions } <- options
+
+    let (fns, mns) = partitionEithers efnmns'
+        ccfns = map (cradleCurrentDir crdl </>) fns
+    cfns <- liftIO $ mapM canonicalizePath ccfns
+    let rfns = map (makeRelative $ cradleRootDir crdl) cfns
+        serfnmn = Set.fromList $ map Right mns ++ map Left rfns
+
+    opts <- targetGhcOptions crdl serfnmn
+    let opts' = opts ++ ghcUserOptions
+
+    initSession opts' $
+        setModeSimple >>> setEmptyLogger >>> mdf
+
+    unGmLoadedT $ wrapper $ do
+      loadTargets (map moduleNameString mns ++ rfns)
+      action
+
+targetGhcOptions :: IOish m
+                  => Cradle
+                  -> Set (Either FilePath ModuleName)
+                  -> GhcModT m [GHCOption]
+targetGhcOptions crdl sefnmn = do
+    when (Set.null sefnmn) $ error "targetGhcOptions: no targets given"
+
+    case cradleCabalFile crdl of
+      Just _ -> cabalOpts
+      Nothing -> sandboxOpts crdl
+ where
+   zipMap f l = l `zip` (f `map` l)
+   cabalOpts = do
+       mcs <- resolveGmComponents Nothing =<< getComponents
+
+       let mdlcs = moduleComponents mcs `zipMap` Set.toList sefnmn
+           candidates = Set.unions $ map snd mdlcs
+
+       when (Set.null candidates) $
+          throwError $ GMECabalCompAssignment mdlcs
+
+       let cn = pickComponent candidates
+       return $ gmcGhcOpts $ fromJust $ Map.lookup cn mcs
+
+moduleComponents :: Map GmComponentName (GmComponent (Set ModulePath))
+                 -> Either FilePath ModuleName
+                 -> Set GmComponentName
+moduleComponents m efnmn =
+    foldr' Set.empty m $ \c s ->
+        let
+            memb =
+              case efnmn of
+                Left fn  -> fn `Set.member` Set.map mpPath (smp c)
+                Right mn -> mn `Set.member` Set.map mpModule (smp c)
+        in if memb
+           then Set.insert (gmcName c) s
+           else s
+ where
+   smp c = Map.keysSet $ gmgGraph $ gmcHomeModuleGraph c
+
+   foldr' b as f = Map.foldr f b as
+
+pickComponent :: Set GmComponentName -> GmComponentName
+pickComponent scn = Set.findMin scn
+
+
+packageGhcOptions :: (MonadIO m, GmEnv m) => m [GHCOption]
+packageGhcOptions = do
+    crdl <- cradle
+    case cradleCabalFile crdl of
+      Just _ -> do
+        (Set.toList . Set.fromList . concat . map snd) `liftM` getGhcPkgOptions
+      Nothing -> sandboxOpts crdl
+
+sandboxOpts :: Monad m => Cradle -> m [String]
+sandboxOpts crdl = return $ ["-i" ++ d | d <- [wdir,rdir]] ++ pkgOpts
+  where
+    pkgOpts = ghcDbStackOpts $ cradlePkgDbStack crdl
+    (wdir, rdir) = (cradleCurrentDir crdl, cradleRootDir crdl)
+
+resolveGmComponent :: (IOish m, GmLog m, GmEnv m)
+    => Maybe [Either FilePath ModuleName] -- ^ Updated modules
+    -> GmComponent (Either FilePath [ModuleName])
+    -> m (GmComponent (Set ModulePath))
+resolveGmComponent mums c@GmComponent {..} =
+  withLightHscEnv gmcGhcSrcOpts $ \env -> do
+    let srcDirs = gmcSourceDirs
+        mg = gmcHomeModuleGraph
+
+    let eps = either (return . Left) (map Right) gmcEntrypoints
+    simp <- liftIO $ resolveEntrypoints env srcDirs eps
+    sump <- liftIO $ case mums of
+        Nothing -> return simp
+        Just ums -> resolveEntrypoints env srcDirs ums
+
+    mg' <- updateHomeModuleGraph env mg simp sump
+
+    return $ c { gmcEntrypoints = simp, gmcHomeModuleGraph = mg' }
+
+resolveEntrypoints :: MonadIO m
+    => HscEnv -> [FilePath] -> [Either FilePath ModuleName] -> m (Set ModulePath)
+resolveEntrypoints env srcDirs ms =
+    liftIO $ Set.fromList . catMaybes <$> resolve `mapM` ms
+ where
+   resolve :: Either FilePath ModuleName -> IO (Maybe ModulePath)
+   resolve (Right mn) = findModulePath env mn
+   resolve (Left fn') = do
+       mfn <- findFile srcDirs fn'
+       case mfn of
+         Nothing -> return Nothing
+         Just fn'' -> do
+             let fn = normalise fn''
+             emn <- fileModuleName env fn
+             return $ case emn of
+                 Left _ -> Nothing
+                 Right mmn -> Just $
+                     case mmn of
+                       Nothing -> mkMainModulePath fn
+                       Just mn -> ModulePath mn fn
+
+resolveGmComponents :: (IOish m, GmState m, GmLog m, GmEnv m)
+                    => Maybe [Either FilePath ModuleName]
+                        -- ^ Updated modules
+                    -> [GmComponent (Either FilePath [ModuleName])]
+                    -> m (Map GmComponentName (GmComponent (Set ModulePath)))
+resolveGmComponents mumns cs = do
+    s <- gmsGet
+    m' <- foldrM' (gmComponents s) cs $ \c m -> do
+        case Map.lookup (gmcName c) m of
+          Nothing -> insertUpdated m c
+          Just c' -> if same gmcRawEntrypoints c c' && same gmcGhcSrcOpts c c'
+                       then return m
+                       else insertUpdated m c
+    gmsPut s { gmComponents = m' }
+    return m'
+
+ where
+   foldrM' b fa f = foldrM f b fa
+   insertUpdated m c = do
+     rc <- resolveGmComponent mumns c
+     return $ Map.insert (gmcName rc) rc m
+
+   same :: Eq b
+        => (forall a. GmComponent a -> b)
+        -> GmComponent c -> GmComponent d -> Bool
+   same f a b = (f a) == (f b)
+

 -- | 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
+loadTargets :: IOish m => [String] -> GmLoadedT m ()
+loadTargets filesOrModules = do
+    gmLog GmDebug "loadTargets" $
+          text "Loading" <+>: fsep (map text filesOrModules)
+
+    targets <- forM filesOrModules (flip guessTarget Nothing)
+    setTargets targets
+
    mode <- getCompilerMode
-    if mode == Intelligent then
-        loadTargets Intelligent
+    if mode == Intelligent
+      then loadTargets' Intelligent
      else do
-        mdls <- G.depanal [] False
+        mdls <- depanal [] False
        let fallback = needsFallback mdls
        if fallback then do
            resetTargets targets
            setIntelligent
-            loadTargets Intelligent
+            gmLog GmInfo "loadTargets" $
+                text "Switching to LinkInMemory/HscInterpreted (memory hungry)"
+            loadTargets' Intelligent
          else
-            loadTargets Simple
+            loadTargets' Simple
  where
-    loadTargets Simple = 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 Intelligent = do
-        df <- G.getSessionDynFlags
-        void $ G.setSessionDynFlags (setModeIntelligent df)
-        void $ G.load LoadAllTargets
+    loadTargets' Simple = do
+        void $ load LoadAllTargets
+
+    loadTargets' Intelligent = do
+        df <- getSessionDynFlags
+        void $ setSessionDynFlags (setModeIntelligent df)
+        void $ load LoadAllTargets
+
    resetTargets targets = do
-        G.setTargets []
-        void $ G.load LoadAllTargets
-        G.setTargets targets
+        setTargets []
+        void $ load LoadAllTargets
+        setTargets targets
+
    setIntelligent = do
-        newdf <- setModeIntelligent <$> G.getSessionDynFlags
-        void $ G.setSessionDynFlags newdf
+        newdf <- setModeIntelligent <$> getSessionDynFlags
+        void $ setSessionDynFlags newdf
        setCompilerMode Intelligent

-needsFallback :: G.ModuleGraph -> Bool
+needsFallback :: ModuleGraph -> Bool
 needsFallback = any $ \ms ->
-                let df = G.ms_hspp_opts ms in
+                let df = ms_hspp_opts ms in
                   Opt_TemplateHaskell `xopt` df
                || Opt_QuasiQuotes     `xopt` df
 #if __GLASGOW_HASKELL__ >= 708
--- a/Language/Haskell/GhcMod/Types.hs
+++ b/Language/Haskell/GhcMod/Types.hs
@ -1,13 +1,29 @@
-module Language.Haskell.GhcMod.Types where
+{-# LANGUAGE DeriveDataTypeable, GADTs, StandaloneDeriving, DataKinds #-}
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+module Language.Haskell.GhcMod.Types (
+    module Language.Haskell.GhcMod.Types
+  , module Types
+  , ModuleName
+  , mkModuleName
+  , moduleNameString
+  ) where

 import Control.Monad.Trans.Control (MonadBaseControl)
-import Data.List (intercalate)
-import qualified Data.Map as M
+import Control.Monad.Error (Error(..))
+import Control.Exception (Exception)
+import Data.Map (Map)
+import qualified Data.Map as Map
+import Data.Set (Set)
+import qualified Data.Set as Set
+import Data.Monoid
+import Data.Typeable (Typeable)
 import Exception (ExceptionMonad)
 import MonadUtils (MonadIO)
-
+import GHC (ModuleName, moduleNameString, mkModuleName)
 import PackageConfig (PackageConfig)

+import Types
+
 -- | A constraint alias (-XConstraintKinds) to make functions dealing with
 -- 'GhcModT' somewhat cleaner.
 --
@ -28,8 +44,10 @@ data Options = Options {
    outputStyle   :: OutputStyle
  -- | Line separator string.
  , lineSeparator :: LineSeparator
-  -- | @ghc@ program name.
-  , ghcProgram    :: FilePath
+  -- | Verbosity
+  , logLevel      :: GmLogLevel
+--  -- | @ghc@ program name.
+--  , ghcProgram    :: FilePath
  -- | @cabal@ program name.
  , cabalProgram  :: FilePath
    -- | GHC command line options set on the @ghc-mod@ command line
@ -48,14 +66,15 @@ data Options = Options {
 defaultOptions :: Options
 defaultOptions = Options {
    outputStyle   = PlainStyle
-  , hlintOpts     = []
-  , ghcProgram    = "ghc"
+  , lineSeparator = LineSeparator "\0"
+  , logLevel      = GmPanic
+--  , ghcProgram    = "ghc"
  , cabalProgram  = "cabal"
  , ghcUserOptions= []
  , operators     = False
  , detailed      = False
  , qualified     = False
-  , lineSeparator = LineSeparator "\0"
+  , hlintOpts     = []
  }

 ----------------------------------------------------------------
@ -76,57 +95,110 @@ data Cradle = Cradle {

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

-- | GHC package database flags.
-data GhcPkgDb = GlobalDb | UserDb | PackageDb String deriving (Eq, Show)
-
-- | A single GHC command line option.
-type GHCOption  = String
-
-- | An include directory for modules.
-type IncludeDir = FilePath
-
-- | A package name.
-type PackageBaseName = String
-
-- | A package version.
-type PackageVersion  = String
-
-- | A package id.
-type PackageId  = String
-
-- | A package's name, verson and id.
-type Package    = (PackageBaseName, PackageVersion, PackageId)
-
-pkgName :: Package -> PackageBaseName
-pkgName (n,_,_) = n
-
-pkgVer :: Package -> PackageVersion
-pkgVer (_,v,_) = v
-
-pkgId :: Package -> PackageId
-pkgId (_,_,i) = i
-
-showPkg :: Package -> String
-showPkg (n,v,_) = intercalate "-" [n,v]
-
-showPkgId :: Package -> String
-showPkgId (n,v,i) = intercalate "-" [n,v,i]
+data GmLogLevel = GmPanic
+                | GmException
+                | GmError
+                | GmWarning
+                | GmInfo
+                | GmDebug
+                  deriving (Eq, Ord, Enum, Bounded, Show, Read)

 -- | Collection of packages
-type PkgDb = (M.Map Package PackageConfig)
+type PkgDb = (Map Package PackageConfig)

-- | Haskell expression.
-type Expression = String
+data GmModuleGraph = GmModuleGraph {
+      gmgFileMap    :: Map FilePath ModulePath,
+      gmgModuleMap  :: Map ModuleName ModulePath,
+      gmgGraph      :: Map ModulePath (Set ModulePath)
+    } deriving (Eq, Ord, Show, Read, Typeable)

-- | Module name.
-type ModuleString = String
+instance Monoid GmModuleGraph where
+    mempty  = GmModuleGraph mempty mempty mempty
+    mappend (GmModuleGraph a b c) (GmModuleGraph a' b' c') =
+        GmModuleGraph (a <> a') (b <> b') (Map.unionWith Set.union c c')

-- | A Module
-type Module = [String]
+data GmComponent eps = GmComponent {
+      gmcName            :: GmComponentName,
+      gmcGhcOpts         :: [GHCOption],
+      gmcGhcSrcOpts      :: [GHCOption],
+      gmcRawEntrypoints  :: Either FilePath [ModuleName],
+      gmcEntrypoints     :: eps,
+      gmcSourceDirs      :: [FilePath],
+      gmcHomeModuleGraph :: GmModuleGraph
+    } deriving (Eq, Ord, Show, Read, Typeable)

-- | Option information for GHC
-data CompilerOptions = CompilerOptions {
-    ghcOptions  :: [GHCOption]  -- ^ Command line options
-  , includeDirs :: [IncludeDir] -- ^ Include directories for modules
-  , depPackages :: [Package]    -- ^ Dependent package names
-  } deriving (Eq, Show)
+data ModulePath = ModulePath { mpModule :: ModuleName, mpPath :: FilePath }
+    deriving (Eq, Ord, Show, Read, Typeable)
+
+instance Show ModuleName where
+    show mn = "ModuleName " ++ show (moduleNameString mn)
+
+instance Read ModuleName where
+    readsPrec d r = readParen (d > app_prec)
+                         (\r' -> [(mkModuleName m,t) |
+                                 ("ModuleName",s) <- lex r',
+                                 (m,t) <- readsPrec (app_prec+1) s]) r
+        where app_prec = 10
+
+
+--- \ / These types MUST be in sync with the copies in cabal-helper/Main.hs
+data GmComponentName = GmSetupHsName
+                     | GmLibName
+                     | GmExeName String
+                     | GmTestName String
+                     | GmBenchName String
+  deriving (Eq, Ord, Read, Show)
+data GmCabalHelperResponse
+    = GmCabalHelperStrings [(GmComponentName, [String])]
+    | GmCabalHelperEntrypoints [(GmComponentName, Either FilePath [ModuleName])]
+    | GmCabalHelperLbi String
+  deriving (Read, Show)
+--- ^ These types MUST be in sync with the copies in cabal-helper/Main.hs
+
+data GhcModError
+    = GMENoMsg
+    -- ^ Unknown error
+
+    | GMEString String
+    -- ^ Some Error with a message. These are produced mostly by
+    -- 'fail' calls on GhcModT.
+
+    | GMECabalConfigure GhcModError
+    -- ^ Configuring a cabal project failed.
+
+    | GMECabalFlags GhcModError
+    -- ^ Retrieval of the cabal configuration flags failed.
+
+    | GMECabalComponent GmComponentName
+    -- ^ Cabal component could not be found
+
+    | GMECabalCompAssignment [(Either FilePath ModuleName, Set GmComponentName)]
+    -- ^ Could not find a consistent component assignment for modules
+
+    | GMEProcess String [String] (Either (String, String, Int) GhcModError)
+    -- ^ Launching an operating system process failed. Fields in
+    -- order: command, arguments, (stdout, stderr, exitcode)
+
+    | GMENoCabalFile
+    -- ^ No cabal file found.
+
+    | GMETooManyCabalFiles [FilePath]
+    -- ^ Too many cabal files found.
+
+    | GMECabalStateFile GMConfigStateFileError
+      -- ^ Reading Cabal's state configuration file falied somehow.
+      deriving (Eq,Show,Typeable)
+
+instance Error GhcModError where
+    noMsg = GMENoMsg
+    strMsg = GMEString
+
+instance Exception GhcModError
+
+data GMConfigStateFileError
+    = GMConfigStateFileNoHeader
+    | GMConfigStateFileBadHeader
+    | GMConfigStateFileNoParse
+    | GMConfigStateFileMissing
+--    | GMConfigStateFileBadVersion PackageIdentifier PackageIdentifier (Either ConfigStateFileError LocalBuildInfo)
+  deriving (Eq, Show, Read, Typeable)
--- a/Language/Haskell/GhcMod/Utils.hs
+++ b/Language/Haskell/GhcMod/Utils.hs
@ -15,28 +15,28 @@
 -- along with this program.  If not, see <http://www.gnu.org/licenses/>.

 {-# LANGUAGE CPP #-}
-module Language.Haskell.GhcMod.Utils where
+module Language.Haskell.GhcMod.Utils (
+    module Language.Haskell.GhcMod.Utils
+  , module Utils
+  , readProcess
+  ) where

 import Control.Arrow
-import Control.Applicative ((<$>))
+import Control.Applicative
 import Data.Char
 import Language.Haskell.GhcMod.Error
-import MonadUtils (MonadIO, liftIO)
+import Exception
 import System.Directory (getCurrentDirectory, setCurrentDirectory, doesFileExist)
-import System.Exit (ExitCode(..))
-import System.Process (readProcessWithExitCode)
+import System.Process (readProcess)
 import System.Directory (getTemporaryDirectory)
-import System.FilePath (splitDrive, pathSeparators, (</>))
+import System.FilePath (splitDrive, takeDirectory, takeFileName, pathSeparators,
+                        (</>))
 import System.IO.Temp (createTempDirectory)
-#ifndef SPEC
-import Paths_ghc_mod (getLibexecDir)
 import System.Environment
-import System.FilePath (takeDirectory)
-#else
-- When compiling test suite
-import Data.IORef
-import System.IO.Unsafe
-#endif
+import Text.Printf
+
+import Paths_ghc_mod (getLibexecDir)
+import Utils

 -- dropWhileEnd is not provided prior to base 4.5.0.0.
 dropWhileEnd :: (a -> Bool) -> [a] -> [a]
@ -54,21 +54,6 @@ extractParens str = extractParens' str 0
       | s `elem` "}])" = s : extractParens' ss (level-1)
       | otherwise = s : extractParens' ss level

-readProcess' :: (MonadIO m, GmError m)
-             => String
-             -> [String]
-             -> m String
-readProcess' cmd opts = do
-  (rv,output,err) <- liftIO (readProcessWithExitCode cmd opts "")
-      `modifyError'` GMEProcess ([cmd] ++ opts)
-  case rv of
-    ExitFailure val -> do
-        throwError $ GMEProcess ([cmd] ++ opts) $ strMsg $
-          cmd ++ " " ++ unwords opts ++ " (exit " ++ show val ++ ")"
-              ++ "\n" ++ err
-    ExitSuccess ->
-        return output
-
 withDirectory_ :: (MonadIO m, ExceptionMonad m) => FilePath -> m a -> m a
 withDirectory_ dir action =
    gbracket (liftIO getCurrentDirectory) (liftIO . setCurrentDirectory)
@ -91,42 +76,85 @@ newTempDir :: FilePath -> IO FilePath
 newTempDir dir =
    flip createTempDirectory (uniqTempDirName dir) =<< getTemporaryDirectory

-mightExist :: FilePath -> IO (Maybe FilePath)
-mightExist f = do
-  exists <- doesFileExist f
-  return $ if exists then (Just f) else (Nothing)
+whenM :: IO Bool -> IO () -> IO ()
+whenM mb ma = mb >>= flip when ma

 -- | Returns the path to the currently running ghc-mod executable. With ghc<7.6
 -- this is a guess but >=7.6 uses 'getExecutablePath'.
 ghcModExecutable :: IO FilePath
 #ifndef SPEC
 ghcModExecutable = do
-    dir <- getExecutablePath'
-    return $ dir </> "ghc-mod"
- where
-    getExecutablePath' :: IO FilePath
-# if __GLASGOW_HASKELL__ >= 706
-    getExecutablePath' = takeDirectory <$> getExecutablePath
-# else
-    getExecutablePath' = return ""
-# endif
+    dir <- takeDirectory <$> getExecutablePath'
+    return $ (if dir == "." then "" else dir) </> "ghc-mod"
 #else
 ghcModExecutable = fmap (</> "dist/build/ghc-mod/ghc-mod") getCurrentDirectory
 #endif

-#ifdef SPEC
-- Ugly workaround :'( but I can't think of any other way of doing this
-- the test suite changes the cwd often so I can't use relative paths :/
-specRootDir :: IORef FilePath
-specRootDir = unsafePerformIO $ newIORef undefined
-{-# NOINLINE specRootDir #-}
-#endif
-
 findLibexecExe :: String -> IO FilePath
-#ifndef SPEC
-findLibexecExe "cabal-helper" = (fmap (</> "cabal-helper")) getLibexecDir
-#else
-findLibexecExe "cabal-helper" =
-    (</> "dist/build/cabal-helper/cabal-helper") <$> (readIORef specRootDir)
-#endif
+findLibexecExe "cabal-helper-wrapper" = do
+    libexecdir <- getLibexecDir
+    let exeName = "cabal-helper-wrapper"
+        exe = libexecdir </> exeName
+
+    exists <- doesFileExist exe
+
+    if exists
+       then return exe
+       else do
+         mdir <- tryFindGhcModTreeDataDir
+         case mdir of
+           Nothing ->
+               error $ libexecNotExitsError exeName libexecdir
+           Just dir ->
+               return $ dir </> "dist" </> "build" </> exeName </> exeName
 findLibexecExe exe = error $ "findLibexecExe: Unknown executable: " ++ exe
+
+libexecNotExitsError :: String -> FilePath -> String
+libexecNotExitsError exe dir = printf
+ ( "Could not find $libexecdir/%s\n"
+ ++"\n"
+ ++"If you are a developer set the environment variable `ghc_mod_libexecdir'\n"
+ ++"to override $libexecdir[1] the following will work in the ghc-mod tree:\n"
+ ++"\n"
+ ++"    $ export ghc_mod_libexecdir=$PWD/dist/build/%s\n"
+ ++"\n"
+ ++"[1]: %s\n"
+ ++"\n"
+ ++"If you don't know what I'm talking about something went wrong with your\n"
+ ++"installation. Please report this problem here:\n"
+ ++"\n"
+ ++"    https://github.com/kazu-yamamoto/ghc-mod/issues") exe exe dir
+
+tryFindGhcModTreeLibexecDir :: IO (Maybe FilePath)
+tryFindGhcModTreeLibexecDir  = do
+  exe <- getExecutablePath
+  dir <- case takeFileName exe of
+    "ghc" -> do -- we're probably in ghci; try CWD
+        getCurrentDirectory
+    _ ->
+        return $ (!!4) $ iterate takeDirectory exe
+  exists <- doesFileExist $ dir </> "ghc-mod.cabal"
+  return $ if exists
+             then Just dir
+             else Nothing
+
+tryFindGhcModTreeDataDir :: IO (Maybe FilePath)
+tryFindGhcModTreeDataDir  = do
+  dir <- (!!4) . iterate takeDirectory <$> getExecutablePath'
+  exists <- doesFileExist $ dir </> "ghc-mod.cabal"
+  return $ if exists
+             then Just dir
+             else Nothing
+
+readLibExecProcess' :: (MonadIO m, ExceptionMonad m)
+                    => String -> [String] -> m String
+readLibExecProcess' cmd args = do
+  exe <- liftIO $ findLibexecExe cmd
+  liftIO $ readProcess exe args ""
+
+getExecutablePath' :: IO FilePath
+#if __GLASGOW_HASKELL__ >= 706
+getExecutablePath' = getExecutablePath
+#else
+getExecutablePath' = getProgName
+#endif
--- a/Language/Haskell/GhcMod/World.hs
+++ b/Language/Haskell/GhcMod/World.hs
@ -1,82 +1,44 @@
-{-# LANGUAGE RecordWildCards, CPP #-}
 module Language.Haskell.GhcMod.World where
-{-(
-  , World
-  , getCurrentWorld
-  , isWorldChanged
-  ) where
-}

 import Language.Haskell.GhcMod.GhcPkg
 import Language.Haskell.GhcMod.PathsAndFiles
 import Language.Haskell.GhcMod.Types
 import Language.Haskell.GhcMod.Utils

-import Control.Applicative (pure, (<$>), (<*>))
-import Control.Monad
+import Control.Applicative ((<$>))
 import Data.Maybe
 import Data.Traversable (traverse)
-import System.Directory (getModificationTime)
 import System.FilePath ((</>))

 import GHC.Paths (libdir)

-#if __GLASGOW_HASKELL__ <= 704
-import System.Time (ClockTime)
-#else
-import Data.Time (UTCTime)
-#endif
-
-
-#if __GLASGOW_HASKELL__ <= 704
-type ModTime = ClockTime
-#else
-type ModTime = UTCTime
-#endif
-
-data TimedFile = TimedFile FilePath ModTime deriving (Eq, Show)
-
-instance Ord TimedFile where
-    compare (TimedFile _ a) (TimedFile _ b) = compare a b
-
-timeFile :: FilePath -> IO TimedFile
-timeFile f = TimedFile <$> pure f <*> getModificationTime f
-
 data World = World {
    worldPackageCaches :: [TimedFile]
  , worldCabalFile     :: Maybe TimedFile
  , worldCabalConfig   :: Maybe TimedFile
  , worldSymbolCache   :: Maybe TimedFile
-  , worldPrettyCabalConfigCache :: Maybe TimedFile
  } deriving (Eq, Show)

-timedPackageCache :: Cradle -> IO [TimedFile]
-timedPackageCache crdl = do
+timedPackageCaches :: Cradle -> IO [TimedFile]
+timedPackageCaches crdl = do
    fs <- mapM mightExist . map (</> packageCache)
            =<< getPackageCachePaths libdir crdl
    timeFile `mapM` catMaybes fs

 getCurrentWorld :: Cradle -> IO World
 getCurrentWorld crdl = do
-    pkgCaches    <- timedPackageCache crdl
+    pkgCaches    <- timedPackageCaches crdl
    mCabalFile   <- timeFile `traverse` cradleCabalFile crdl
    mCabalConfig <- timeMaybe (setupConfigFile crdl)
    mSymbolCache <- timeMaybe (symbolCache crdl)
-    mPrettyConfigCache <- timeMaybe prettyConfigCache

    return World {
        worldPackageCaches = pkgCaches
      , worldCabalFile     = mCabalFile
      , worldCabalConfig   = mCabalConfig
      , worldSymbolCache   = mSymbolCache
-      , worldPrettyCabalConfigCache = mPrettyConfigCache
      }

- where
-   timeMaybe :: FilePath -> IO (Maybe TimedFile)
-   timeMaybe f = do
-     join $ (timeFile `traverse`) <$> mightExist f
-
 didWorldChange :: World -> Cradle -> IO Bool
 didWorldChange world crdl = do
    (world /=) <$> getCurrentWorld crdl
--- a/Utils.hs
+++ b/Utils.hs
@ -0,0 +1,36 @@
+{-# LANGUAGE CPP #-}
+module Utils where
+
+import Control.Monad
+import Control.Applicative
+import Data.Traversable
+import System.Directory
+
+#if MIN_VERSION_directory(1,2,0)
+import Data.Time (UTCTime)
+#else
+import System.Time (ClockTime)
+#endif
+
+#if MIN_VERSION_directory(1,2,0)
+type ModTime = UTCTime
+#else
+type ModTime = ClockTime
+#endif
+
+data TimedFile = TimedFile FilePath ModTime deriving (Eq, Show)
+
+instance Ord TimedFile where
+    compare (TimedFile _ a) (TimedFile _ b) = compare a b
+
+timeFile :: FilePath -> IO TimedFile
+timeFile f = TimedFile <$> pure f <*> getModificationTime f
+
+mightExist :: FilePath -> IO (Maybe FilePath)
+mightExist f = do
+  exists <- doesFileExist f
+  return $ if exists then (Just f) else (Nothing)
+
+timeMaybe :: FilePath -> IO (Maybe TimedFile)
+timeMaybe f = do
+  join $ (timeFile `traverse`) <$> mightExist f
--- a/ghc-mod.cabal
+++ b/ghc-mod.cabal
@ -19,14 +19,15 @@ Description:            The ghc-mod command is a backend command to enrich
                        For more information, please see its home page.

 Category:               Development
-Cabal-Version:          >= 1.10
+Cabal-Version:          >= 1.16
 Build-Type:             Custom
-Data-Dir:               elisp
-Data-Files:             Makefile ghc.el ghc-func.el ghc-doc.el ghc-comp.el
-                        ghc-check.el ghc-process.el ghc-command.el ghc-info.el
-                        ghc-ins-mod.el ghc-indent.el ghc-pkg.el ghc-rewrite.el
+Data-Files:             elisp/Makefile
+                        elisp/*.el
+                        cabal-helper/*.hs
+
 Extra-Source-Files:     ChangeLog
                        SetupCompat.hs
+                        NotCPP/*.hs
 			test/data/*.cabal
                        test/data/*.hs
                        test/data/cabal.sandbox.config.in
@ -56,29 +57,23 @@ Extra-Source-Files:     ChangeLog
                        test/data/subdir1/subdir2/dummy
                        test/data/.cabal-sandbox/packages/00-index.tar

-Flag cabal-122
-  Default:              True
-  Manual:               False
-
 Library
  Default-Language:     Haskell2010
-  GHC-Options:          -Wall
-  Default-Extensions:   ConstraintKinds, FlexibleContexts
+  GHC-Options:          -Wall -fno-warn-deprecations
+  Default-Extensions:   ScopedTypeVariables, RecordWildCards, NamedFieldPuns,
+                        ConstraintKinds, FlexibleContexts
  Exposed-Modules:      Language.Haskell.GhcMod
                        Language.Haskell.GhcMod.Internal
  Other-Modules:        Paths_ghc_mod
+                        Types
+                        Utils
                        Language.Haskell.GhcMod.Boot
                        Language.Haskell.GhcMod.Browse
-                        Language.Haskell.GhcMod.CabalConfig.Cabal16
-                        Language.Haskell.GhcMod.CabalConfig.Cabal18
-                        Language.Haskell.GhcMod.CabalConfig.Cabal22
-                        Language.Haskell.GhcMod.CabalConfig.Extract
-                        Language.Haskell.GhcMod.CabalConfig
-                        Language.Haskell.GhcMod.CabalApi
                        Language.Haskell.GhcMod.CaseSplit
                        Language.Haskell.GhcMod.Check
                        Language.Haskell.GhcMod.Convert
                        Language.Haskell.GhcMod.Cradle
+                        Language.Haskell.GhcMod.CabalHelper
                        Language.Haskell.GhcMod.Debug
                        Language.Haskell.GhcMod.Doc
                        Language.Haskell.GhcMod.DynFlags
@ -86,9 +81,9 @@ Library
                        Language.Haskell.GhcMod.FillSig
                        Language.Haskell.GhcMod.Find
                        Language.Haskell.GhcMod.Flag
-                        Language.Haskell.GhcMod.GHCChoice
                        Language.Haskell.GhcMod.Gap
                        Language.Haskell.GhcMod.GhcPkg
+                        Language.Haskell.GhcMod.HomeModuleGraph
                        Language.Haskell.GhcMod.Info
                        Language.Haskell.GhcMod.Lang
                        Language.Haskell.GhcMod.Lint
@ -99,14 +94,13 @@ Library
                        Language.Haskell.GhcMod.Monad.Types
                        Language.Haskell.GhcMod.PathsAndFiles
                        Language.Haskell.GhcMod.PkgDoc
+                        Language.Haskell.GhcMod.Pretty
                        Language.Haskell.GhcMod.Read
                        Language.Haskell.GhcMod.SrcUtils
                        Language.Haskell.GhcMod.Target
                        Language.Haskell.GhcMod.Types
                        Language.Haskell.GhcMod.Utils
                        Language.Haskell.GhcMod.World
-
-
  Build-Depends:        base >= 4.0 && < 5
                      , bytestring
                      , containers
@ -117,7 +111,6 @@ Library
                      , ghc-paths
                      , ghc-syb-utils
                      , hlint >= 1.8.61
-                      , io-choice
                      , monad-journal >= 0.4
                      , old-time
                      , pretty
@ -128,18 +121,13 @@ Library
                      , transformers
                      , transformers-base
                      , mtl >= 2.0
-                      , monad-control
+                      , monad-control >= 1
                      , split
                      , haskell-src-exts
                      , text
                      , djinn-ghc >= 0.0.2.2
  if impl(ghc < 7.8)
    Build-Depends:      convertible
-                      , Cabal >= 1.10 && < 1.17
-  else
-    Build-Depends:      Cabal >= 1.18
-  if flag(cabal-122)
-    Build-Depends:      Cabal >= 1.22
  if impl(ghc <= 7.4.2)
    -- Only used to constrain random to a version that still works with GHC 7.4
    Build-Depends:      random <= 1.0.1.1
@ -148,7 +136,7 @@ Executable ghc-mod
  Default-Language:     Haskell2010
  Main-Is:              GHCMod.hs
  Other-Modules:        Paths_ghc_mod
-  GHC-Options:          -Wall
+  GHC-Options:          -Wall -fno-warn-deprecations
  Default-Extensions:   ConstraintKinds, FlexibleContexts
  HS-Source-Dirs:       src
  Build-Depends:        base >= 4.0 && < 5
@ -169,7 +157,7 @@ Executable ghc-modi
  Other-Modules:        Paths_ghc_mod
                        Misc
                        Utils
-  GHC-Options:          -Wall -threaded
+  GHC-Options:          -Wall -threaded -fno-warn-deprecations
  if os(windows)
      Cpp-Options:      -DWINDOWS
  Default-Extensions:   ConstraintKinds, FlexibleContexts
@ -218,16 +206,20 @@ Test-Suite doctest

 Test-Suite spec
  Default-Language:     Haskell2010
-  Default-Extensions:   ConstraintKinds, FlexibleContexts
+  Default-Extensions:   ScopedTypeVariables, RecordWildCards, NamedFieldPuns,
+                        ConstraintKinds, FlexibleContexts, OverloadedStrings
  Main-Is:              Main.hs
  Hs-Source-Dirs:       test, .
-  Ghc-Options:          -Wall
+  Ghc-Options:          -Wall -fno-warn-deprecations
  CPP-Options:          -DSPEC=1
  Type:                 exitcode-stdio-1.0
-  Other-Modules:        BrowseSpec
-                        CabalApiSpec
-                        CheckSpec
+  Other-Modules:        Paths_ghc_mod
+                        Types
                        Dir
+                        Spec
+                        TestUtils
+                        BrowseSpec
+                        CheckSpec
                        FlagSpec
                        InfoSpec
                        LangSpec
@ -235,8 +227,7 @@ Test-Suite spec
                        ListSpec
                        MonadSpec
                        PathsAndFilesSpec
-                        Spec
-                        TestUtils
+                        HomeModuleGraphSpec

  Build-Depends:        hspec
  if impl(ghc == 7.4.*)
--- a/src/GHCMod.hs
+++ b/src/GHCMod.hs
@ -259,8 +259,9 @@ reqArg udsc dsc = ReqArg dsc udsc

 globalArgSpec :: [OptDescr (Options -> Options)]
 globalArgSpec =
-      [ option "v" ["verbose"] "Be more verbose." $
-               NoArg $ \o -> o { ghcUserOptions = "-v" : ghcUserOptions o }
+      [ option "v" ["verbose"] "Can be given multiple times to be increasingly\
+                               \more verbose." $
+               NoArg $ \o -> o { logLevel = increaseLogLevel (logLevel o) }

      , option "l" ["tolisp"] "Format output as an S-Expression" $
               NoArg $ \o -> o { outputStyle = LispStyle }
@ -272,8 +273,8 @@ globalArgSpec =
               reqArg "OPT" $ \g o ->
                   o { ghcUserOptions = g : ghcUserOptions o }

-      , option "" ["with-ghc"] "GHC executable to use" $
-               reqArg "PROG" $ \p o -> o { ghcProgram = p }
+--      , option "" ["with-ghc"] "GHC executable to use" $
+--               reqArg "PROG" $ \p o -> o { ghcProgram = p }

      , option "" ["with-cabal"] "cabal-install executable to use" $
               reqArg "PROG" $ \p o -> o { cabalProgram = p }