Merge remote-tracking branch 'kazu/master'

Conflicts:
	Language/Haskell/GhcMod.hs
	Language/Haskell/GhcMod/Check.hs
	Language/Haskell/GhcMod/FillSig.hs
	Language/Haskell/GhcMod/GHCApi.hs
	Language/Haskell/GhcMod/Ghc.hs
	src/GHCMod.hs

.travis.yml

@@ -1,33 +1,25 @@
-env:
+language: haskell
-  - GHCVER=7.4.2
+ghc:
-  - GHCVER=7.6.3
+  - 7.4
-  - GHCVER=7.8.2
+  - 7.6
-
+  - 7.8
-before_install:
-  - sudo add-apt-repository -y ppa:hvr/ghc
-  - sudo apt-get update
-  - sudo apt-get install cabal-install-1.18 ghc-$GHCVER happy-1.19.3
-  - export PATH=/opt/ghc/$GHCVER/bin:/opt/cabal/1.18/bin:/opt/happy/1.19.3/bin:$PATH
 
 install:
   - cabal update
-  - cabal install --only-dependencies --enable-tests
+  - cabal install happy --constraint 'transformers <= 0.3.0.0'
+  - happy --version
+  - cabal install -j --only-dependencies --enable-tests
 
 script:
+  - cabal check
+  - cabal sdist
+  - export SRC_TGZ="$PWD/dist/$(cabal info . | awk '{print $2 ".tar.gz";exit}')"
+  - rm -rf /tmp/test && mkdir -p /tmp/test
+  - cd /tmp/test
+  - tar -xf $SRC_TGZ && cd ghc-mod*/
   - cabal configure --enable-tests
   - cabal build
   - cabal test
-  - cabal check
-  - cabal sdist
-  # The following scriptlet checks that the resulting source distribution can be built & installed
-  - export SRC_TGZ=$(cabal info . | awk '{print $2 ".tar.gz";exit}');
-    cd dist/;
-    if [ -f "$SRC_TGZ" ]; then
-      cabal install --enable-tests "$SRC_TGZ";
-    else
-      echo "expected '$SRC_TGZ' not found";
-      exit 1;
-    fi
 
 matrix:
   allow_failures:

Language/Haskell/GhcMod.hs

@@ -12,24 +12,25 @@ module Language.Haskell.GhcMod (
   -- * Types
   , ModuleString
   , Expression
-  -- * 'IO' utilities
+  , GhcPkgDb
-  , bootInfo
+  -- * 'GhcMod' utilities
+  , boot
   , browse
+  , check
   , checkSyntax
-  , lintSyntax
-  , expandTemplate
-  , infoExpr
-  , typeExpr
-  , fillSig
-  , refineVar
-  , listModules
-  , listLanguages
-  , listFlags
   , debugInfo
-  , rootInfo
+  , expandTemplate
-  , packageDoc
   , findSymbol
-  , splitVar
+  , info
+  , lint
+  , pkgDoc
+  , rootInfo
+  , types
+  , splits
+  , sig
+  , modules
+  , languages
+  , flags
   ) where
 
 import Language.Haskell.GhcMod.Boot

Language/Haskell/GhcMod/Boot.hs

@@ -1,27 +1,16 @@
 module Language.Haskell.GhcMod.Boot where
 
-import Control.Applicative ((<$>))
+import Control.Applicative
-import CoreMonad (liftIO, liftIO)
 import Language.Haskell.GhcMod.Browse
 import Language.Haskell.GhcMod.Flag
 import Language.Haskell.GhcMod.Lang
 import Language.Haskell.GhcMod.List
 import Language.Haskell.GhcMod.Monad
-import Language.Haskell.GhcMod.Types
 
 -- | Printing necessary information for front-end booting.
-bootInfo :: Options -> IO String
+boot :: IOish m => GhcModT m String
-bootInfo opt = runGhcMod opt $ boot
+boot =  concat <$> sequence [modules, languages, flags,
-
+                             concat <$> mapM browse preBrowsedModules]
--- | Printing necessary information for front-end booting.
-boot :: GhcMod String
-boot = do
-    opt   <- options
-    mods  <- modules
-    langs <- liftIO $ listLanguages opt
-    flags <- liftIO $ listFlags opt
-    pre   <- concat <$> mapM browse preBrowsedModules
-    return $ mods ++ langs ++ flags ++ pre
 
 preBrowsedModules :: [String]
 preBrowsedModules = [

Language/Haskell/GhcMod/Browse.hs

@@ -10,10 +10,10 @@ import Data.List (sort)
 import Data.Maybe (catMaybes)
 import Exception (ghandle)
 import FastString (mkFastString)
-import GHC (GhcException(CmdLineError), ModuleInfo, Name, TyThing, DynFlags, Type, TyCon, Module)
+import GHC (GhcException(CmdLineError), ModuleInfo, Name, TyThing, DynFlags, Type, TyCon)
 import qualified GHC as G
 import Language.Haskell.GhcMod.Doc (showPage, showOneLine, styleUnqualified)
-import Language.Haskell.GhcMod.GHCApi
+import Language.Haskell.GhcMod.DynFlags
 import Language.Haskell.GhcMod.Gap
 import Language.Haskell.GhcMod.Monad
 import Language.Haskell.GhcMod.Convert
@@ -28,8 +28,9 @@ import Type (dropForAlls, splitFunTy_maybe, mkFunTy, isPredTy)
 -- | 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 :: ModuleString -- ^ A module name. (e.g. \"Data.List\")
+browse :: IOish m
-       -> GhcMod String
+       => ModuleString -- ^ A module name. (e.g. \"Data.List\")
+       -> GhcModT m String
 browse pkgmdl = convert' . sort =<< (listExports =<< getModule)
   where
     (mpkg,mdl) = splitPkgMdl pkgmdl
@@ -61,7 +62,7 @@ splitPkgMdl pkgmdl = case break (==':') pkgmdl of
     (mdl,"")    -> (Nothing,mdl)
     (pkg,_:mdl) -> (Just pkg,mdl)
 
-processExports :: ModuleInfo -> GhcMod [String]
+processExports :: IOish m => ModuleInfo -> GhcModT m [String]
 processExports minfo = do
   opt <- options
   let
@@ -70,13 +71,13 @@ processExports minfo = do
       | otherwise = filter (isAlpha . head . getOccString)
   mapM (showExport opt minfo) $ removeOps $ G.modInfoExports minfo
 
-showExport :: Options -> ModuleInfo -> Name -> GhcMod String
+showExport :: IOish m => Options -> ModuleInfo -> Name -> GhcModT 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 :: GhcMod (Maybe String)
+    mtype :: IOish m => GhcModT m (Maybe String)
     mtype
       | detailed opt = do
         tyInfo <- G.modInfoLookupName minfo e
@@ -91,7 +92,7 @@ showExport opt minfo e = do
       | isAlpha n = nm
       | otherwise = "(" ++ nm ++ ")"
     formatOp "" = error "formatOp"
-    inOtherModule :: Name -> GhcMod (Maybe TyThing)
+    inOtherModule :: IOish m => Name -> GhcModT m (Maybe TyThing)
     inOtherModule nm = G.getModuleInfo (G.nameModule nm) >> G.lookupGlobalName nm
     justIf :: a -> Bool -> Maybe a
     justIf x True = Just x
@@ -138,13 +139,13 @@ showOutputable dflag = unwords . lines . showPage dflag styleUnqualified . ppr
 ----------------------------------------------------------------
 
 -- | Browsing all functions in all system/user modules.
-browseAll :: DynFlags -> GhcMod [(String,String)]
+browseAll :: IOish m => DynFlags -> GhcModT m [(String,String)]
 browseAll dflag = do
     ms <- G.packageDbModules True
     is <- mapM G.getModuleInfo ms
     return $ concatMap (toNameModule dflag) (zip ms is)
 
-toNameModule :: DynFlags -> (Module, Maybe ModuleInfo) -> [(String,String)]
+toNameModule :: DynFlags -> (G.Module, Maybe ModuleInfo) -> [(String,String)]
 toNameModule _     (_,Nothing)  = []
 toNameModule dflag (m,Just inf) = map (\name -> (toStr name, mdl)) names
   where

Language/Haskell/GhcMod/CabalApi.hs

@@ -10,9 +10,10 @@ module Language.Haskell.GhcMod.CabalApi (
   , cabalConfigDependencies
   ) where
 
-import Language.Haskell.GhcMod.Types
-import Language.Haskell.GhcMod.GhcPkg
 import Language.Haskell.GhcMod.CabalConfig
+import Language.Haskell.GhcMod.Gap (benchmarkBuildInfo, benchmarkTargets, toModuleString)
+import Language.Haskell.GhcMod.GhcPkg
+import Language.Haskell.GhcMod.Types
 
 import Control.Applicative ((<$>))
 import qualified Control.Exception as E
@@ -20,7 +21,6 @@ import Control.Monad (filterM)
 import CoreMonad (liftIO)
 import Data.Maybe (maybeToList)
 import Data.Set (fromList, toList)
-import Distribution.ModuleName (ModuleName,toFilePath)
 import Distribution.Package (Dependency(Dependency)
                            , PackageName(PackageName))
 import qualified Distribution.Package as C
@@ -119,11 +119,7 @@ cabalAllBuildInfo pd = libBI ++ execBI ++ testBI ++ benchBI
     libBI   = map P.libBuildInfo       $ maybeToList $ P.library pd
     execBI  = map P.buildInfo          $ P.executables pd
     testBI  = map P.testBuildInfo      $ P.testSuites pd
-#if __GLASGOW_HASKELL__ >= 704
+    benchBI = benchmarkBuildInfo pd
-    benchBI = map P.benchmarkBuildInfo $ P.benchmarks pd
-#else
-    benchBI = []
-#endif
 
 ----------------------------------------------------------------
 
@@ -172,16 +168,7 @@ cabalAllTargets pd = do
             Just l -> P.libModules l
 
     libTargets = map toModuleString lib
-#if __GLASGOW_HASKELL__ >= 704
+    benchTargets = benchmarkTargets pd
-    benchTargets = map toModuleString $ concatMap P.benchmarkModules $ P.benchmarks  pd
-#else
-    benchTargets = []
-#endif
-    toModuleString :: ModuleName -> String
-    toModuleString mn = fromFilePath $ toFilePath mn
-
-    fromFilePath :: FilePath -> String
-    fromFilePath fp = map (\c -> if c=='/' then '.' else c) fp
 
     getTestTarget :: TestSuite -> IO [String]
     getTestTarget ts =

Language/Haskell/GhcMod/CaseSplit.hs

@@ -1,28 +1,24 @@
 {-# LANGUAGE CPP #-}
 
 module Language.Haskell.GhcMod.CaseSplit (
-    splitVar
+    splits
-  , splits
   ) where
 
+import CoreMonad (liftIO)
 import Data.List (find, intercalate)
 import qualified Data.Text as T
 import qualified Data.Text.IO as T (readFile)
+import qualified DataCon as Ty
 import Exception (ghandle, SomeException(..))
-import GHC (GhcMonad, LHsBind, LHsExpr, LPat, Id, ParsedModule(..), TypecheckedModule(..), DynFlags, SrcSpan, Type, GenLocated(L))
+import GHC (GhcMonad, LHsBind, LPat, Id, ParsedModule(..), TypecheckedModule(..), DynFlags, SrcSpan, Type, GenLocated(L))
 import qualified GHC as G
-import Language.Haskell.GhcMod.GHCApi
+import Language.Haskell.GhcMod.Convert
-import Language.Haskell.GhcMod.Gap (HasType(..))
 import qualified Language.Haskell.GhcMod.Gap as Gap
 import Language.Haskell.GhcMod.Monad
 import Language.Haskell.GhcMod.SrcUtils
-import Language.Haskell.GhcMod.Types
-import Language.Haskell.GhcMod.Convert
-import MonadUtils (liftIO)
 import Outputable (PprStyle)
-import qualified Type as Ty
 import qualified TyCon as Ty
-import qualified DataCon as Ty
+import qualified Type as Ty
 
 ----------------------------------------------------------------
 -- CASE SPLITTING
@@ -36,21 +32,11 @@ data SplitToTextInfo = SplitToTextInfo { sVarName     :: String
                                        }
 
 -- | Splitting a variable in a equation.
-splitVar :: Options
+splits :: IOish m
-         -> Cradle
+       => FilePath     -- ^ A target file.
-         -> FilePath     -- ^ A target file.
-         -> Int          -- ^ Line number.
-         -> Int          -- ^ Column number.
-         -> IO String
-splitVar opt cradle file lineNo colNo = runGhcMod opt $ do
-    initializeFlagsWithCradle opt cradle
-    splits file lineNo colNo
-
--- | Splitting a variable in a equation.
-splits :: FilePath     -- ^ A target file.
        -> Int          -- ^ Line number.
        -> Int          -- ^ Column number.
-       -> GhcMod String
+       -> GhcModT m String
 splits file lineNo colNo = ghandle handler body
   where
     body = inModuleContext file $ \dflag style -> do
@@ -73,17 +59,12 @@ getSrcSpanTypeForSplit modSum lineNo colNo = do
     tcm@TypecheckedModule{tm_typechecked_source = tcs} <- G.typecheckModule p
     let bs:_ = listifySpans tcs (lineNo, colNo) :: [LHsBind Id]
         varPat  = find isPatternVar $ listifySpans tcs (lineNo, colNo) :: Maybe (LPat Id)
-        match:_ = listifyParsedSpans pms (lineNo, colNo)
+        match:_ = listifyParsedSpans pms (lineNo, colNo) :: [Gap.GLMatch]
-#if __GLASGOW_HASKELL__ < 708
-                    :: [G.LMatch G.RdrName]
-#else
-                    :: [G.LMatch G.RdrName (LHsExpr G.RdrName)]
-#endif
     case varPat of
       Nothing  -> return Nothing
       Just varPat' -> do
-        varT <- getType tcm varPat'  -- Finally we get the type of the var
+        varT <- Gap.getType tcm varPat'  -- Finally we get the type of the var
-        bsT  <- getType tcm bs
+        bsT  <- Gap.getType tcm bs
         case (varT, bsT) of
           (Just varT', Just (_,bsT')) ->
             let (L matchL (G.Match _ _ (G.GRHSs rhsLs _))) = match
@@ -212,7 +193,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 text (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'

Language/Haskell/GhcMod/Check.hs

@@ -6,7 +6,7 @@ module Language.Haskell.GhcMod.Check (
   ) where
 
 import Control.Applicative ((<$>))
-import Language.Haskell.GhcMod.GHCApi
+import Language.Haskell.GhcMod.DynFlags
 import qualified Language.Haskell.GhcMod.Gap as Gap
 import Language.Haskell.GhcMod.Logger
 import Language.Haskell.GhcMod.Monad
@@ -15,8 +15,9 @@ import Language.Haskell.GhcMod.Monad
 
 -- | Checking syntax of a target file using GHC.
 --   Warnings and errors are returned.
-checkSyntax :: [FilePath]  -- ^ The target files.
+checkSyntax :: IOish m
-            -> GhcMod String
+            => [FilePath]  -- ^ The target files.
+            -> GhcModT m String
 checkSyntax [] = return ""
 checkSyntax files = withErrorHandler sessionName $ do
     either id id <$> check files
@@ -29,17 +30,19 @@ checkSyntax files = withErrorHandler sessionName $ do
 
 -- | Checking syntax of a target file using GHC.
 --   Warnings and errors are returned.
-check :: [FilePath]  -- ^ The target files.
+check :: IOish m
-      -> GhcMod (Either String String)
+      => [FilePath]  -- ^ The target files.
+      -> GhcModT m (Either String String)
 check fileNames = do
-  withLogger (setAllWaringFlags . setNoMaxRelevantBindings) $ do
+  withLogger (setAllWaringFlags . setNoMaxRelevantBindings) $
     setTargetFiles fileNames
 
 ----------------------------------------------------------------
 
 -- | Expanding Haskell Template.
-expandTemplate :: [FilePath]  -- ^ The target files.
+expandTemplate :: IOish m
-               -> GhcMod String
+               => [FilePath]  -- ^ The target files.
+               -> GhcModT m String
 expandTemplate [] = return ""
 expandTemplate files = withErrorHandler sessionName $ do
     either id id <$> expand files
@@ -51,7 +54,8 @@ expandTemplate files = withErrorHandler sessionName $ do
 ----------------------------------------------------------------
 
 -- | Expanding Haskell Template.
-expand :: [FilePath]  -- ^ The target files.
+expand :: IOish m
-      -> GhcMod (Either String String)
+       => [FilePath]  -- ^ The target files.
+       -> GhcModT m (Either String String)
 expand fileNames = withLogger (Gap.setDumpSplices . setNoWaringFlags) $
     setTargetFiles fileNames

Language/Haskell/GhcMod/Convert.hs

@@ -23,7 +23,7 @@ inter :: Char -> [Builder] -> Builder
 inter _ [] = id
 inter c bs = foldr1 (\x y -> x . (c:) . y) bs
 
-convert' :: ToString a => a -> GhcMod String
+convert' :: (ToString a, IOish m) => a -> GhcModT m String
 convert' x = flip convert x <$> options
 
 convert :: ToString a => Options -> a -> String

Language/Haskell/GhcMod/Cradle.hs

@@ -1,5 +1,6 @@
 module Language.Haskell.GhcMod.Cradle (
     findCradle
+  , findCradle'
   , findCradleWithoutSandbox
   ) where
 
@@ -22,8 +23,10 @@ import System.FilePath ((</>), takeDirectory)
 --   in a cabal directory.
 findCradle :: IO Cradle
 findCradle = do
-    wdir <- getCurrentDirectory
+    findCradle' =<< getCurrentDirectory
-    cabalCradle wdir ||> sandboxCradle wdir ||> plainCradle wdir
+
+findCradle' :: FilePath -> IO Cradle
+findCradle' dir = cabalCradle dir ||> sandboxCradle dir ||> plainCradle dir
 
 cabalCradle :: FilePath -> IO Cradle
 cabalCradle wdir = do

Language/Haskell/GhcMod/Debug.hs

@@ -1,55 +1,42 @@
 module Language.Haskell.GhcMod.Debug (debugInfo, rootInfo) where
 
 import Control.Applicative ((<$>))
-import Control.Exception.IOChoice ((||>))
 import CoreMonad (liftIO)
 import Data.List (intercalate)
-import Data.Maybe (fromMaybe, isJust, fromJust)
+import Data.Maybe (isJust, fromJust)
-import Language.Haskell.GhcMod.CabalApi
-import Language.Haskell.GhcMod.GHCApi
 import Language.Haskell.GhcMod.Convert
+import Language.Haskell.GhcMod.Monad
 import Language.Haskell.GhcMod.Types
+import Language.Haskell.GhcMod.Internal
 
 ----------------------------------------------------------------
 
 -- | Obtaining debug information.
-debugInfo :: Options
+debugInfo :: IOish m => GhcModT m String
-          -> Cradle
+debugInfo = cradle >>= \c -> convert' =<< do
-          -> IO String
-debugInfo opt cradle = convert opt <$> do
     CompilerOptions gopts incDir pkgs <-
-        if cabal then
+        if isJust $ cradleCabalFile c then
-            liftIO (fromCabalFile ||> return simpleCompilerOption)
+            (fromCabalFile c ||> simpleCompilerOption)
           else
-            return simpleCompilerOption
+            simpleCompilerOption
-    mglibdir <- liftIO getSystemLibDir
     return [
-        "Root directory:      " ++ rootDir
+        "Root directory:      " ++ cradleRootDir c
-      , "Current directory:   " ++ currentDir
+      , "Current directory:   " ++ cradleCurrentDir c
-      , "Cabal file:          " ++ cabalFile
+      , "Cabal file:          " ++ show (cradleCabalFile c)
       , "GHC options:         " ++ unwords gopts
       , "Include directories: " ++ unwords incDir
       , "Dependent packages:  " ++ intercalate ", " (map showPkg pkgs)
-      , "System libraries:    " ++ fromMaybe "" mglibdir
+      , "System libraries:    " ++ ghcLibDir
       ]
   where
-    currentDir = cradleCurrentDir cradle
+    simpleCompilerOption = options >>= \op ->
-    mCabalFile = cradleCabalFile cradle
+        return $ CompilerOptions (ghcOpts op) [] []
-    rootDir    = cradleRootDir cradle
+    fromCabalFile c = options >>= \opts -> liftIO $ do
-    cabal = isJust mCabalFile
+        pkgDesc <- parseCabalFile $ fromJust $ cradleCabalFile c
-    cabalFile = fromMaybe "" mCabalFile
+        getCompilerOptions (ghcOpts opts) c pkgDesc
-    origGopts = ghcOpts opt
-    simpleCompilerOption = CompilerOptions origGopts [] []
-    fromCabalFile = do
-        pkgDesc <- parseCabalFile file
-        getCompilerOptions origGopts cradle pkgDesc
-      where
-        file = fromJust mCabalFile
 
 ----------------------------------------------------------------
 
 -- | Obtaining root information.
-rootInfo :: Options
+rootInfo :: IOish m => GhcModT m String
-          -> Cradle
+rootInfo = convert' =<< cradleRootDir <$> cradle
-          -> IO String
-rootInfo opt cradle = return $ convert opt $ cradleRootDir cradle

Language/Haskell/GhcMod/DynFlags.hs

@@ -0,0 +1,155 @@
+{-# LANGUAGE CPP #-}
+
+module Language.Haskell.GhcMod.DynFlags where
+
+import qualified Language.Haskell.GhcMod.Gap as Gap
+import Language.Haskell.GhcMod.Types
+
+import Control.Applicative ((<$>))
+import Control.Monad (forM, void, (>=>))
+import GHC (DynFlags(..), GhcMode(..), GhcLink(..), HscTarget(..), LoadHowMuch(..))
+import qualified GHC as G
+import GhcMonad
+import GHC.Paths (libdir)
+import DynFlags (ExtensionFlag(..), xopt)
+
+import System.IO.Unsafe (unsafePerformIO)
+
+data Build = CabalPkg | SingleFile deriving Eq
+
+setEmptyLogger :: DynFlags -> DynFlags
+setEmptyLogger df = Gap.setLogAction df $ \_ _ _ _ _ -> return ()
+
+-- Fast
+-- Friendly to foreign export
+-- Not friendly to Template Haskell
+-- Uses small memory
+setModeSimple :: DynFlags -> DynFlags
+setModeSimple df = df {
+    ghcMode   = CompManager
+  , ghcLink   = NoLink
+  , hscTarget = HscNothing
+  , optLevel  = 0
+  }
+
+-- Slow
+-- Not friendly to foreign export
+-- Friendly to Template Haskell
+-- Uses large memory
+setModeIntelligent :: DynFlags -> DynFlags
+setModeIntelligent df = df {
+    ghcMode   = CompManager
+  , ghcLink   = LinkInMemory
+  , hscTarget = HscInterpreted
+  , optLevel  = 0
+  }
+
+setIncludeDirs :: [IncludeDir] -> DynFlags -> DynFlags
+setIncludeDirs idirs df = df { importPaths = idirs }
+
+setBuildEnv :: Build -> DynFlags -> DynFlags
+setBuildEnv build = setHideAllPackages build . setCabalPackage build
+
+-- At the moment with this option set ghc only prints different error messages,
+-- suggesting the user to add a hidden package to the build-depends in his cabal
+-- file for example
+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)
+  where
+    tfst (a,_,_) = a
+
+----------------------------------------------------------------
+
+-- | Set the files as targets and load them.
+setTargetFiles :: (GhcMonad m) => [FilePath] -> m ()
+setTargetFiles files = do
+    targets <- forM files $ \file -> G.guessTarget file Nothing
+    G.setTargets targets
+    xs <- G.depanal [] False
+    -- FIXME, checking state
+    loadTargets $ needsFallback xs
+  where
+    loadTargets False = do
+        -- Reporting error A and error B
+        void $ G.load LoadAllTargets
+        mss <- filter (\x -> G.ms_hspp_file x `elem` files) <$> G.getModuleGraph
+        -- Reporting error B and error C
+        mapM_ (G.parseModule >=> G.typecheckModule >=> G.desugarModule) mss
+        -- Error B duplicates. But we cannot ignore both error reportings,
+        -- sigh. So, the logger makes log messages unique by itself.
+    loadTargets True = do
+        df <- G.getSessionDynFlags
+        void $ G.setSessionDynFlags (setModeIntelligent df)
+        void $ G.load LoadAllTargets
+
+needsFallback :: G.ModuleGraph -> Bool
+needsFallback = any (hasTHorQQ . G.ms_hspp_opts)
+  where
+    hasTHorQQ :: DynFlags -> Bool
+    hasTHorQQ dflags = any (`xopt` dflags) [Opt_TemplateHaskell, Opt_QuasiQuotes]
+
+----------------------------------------------------------------
+
+-- | Return the 'DynFlags' currently in use in the GHC session.
+getDynamicFlags :: IO DynFlags
+getDynamicFlags = do
+    G.runGhc (Just libdir) G.getSessionDynFlags
+
+withDynFlags :: GhcMonad m
+             => (DynFlags -> DynFlags)
+             -> m a
+             -> m a
+withDynFlags setFlags body = G.gbracket setup teardown (\_ -> body)
+  where
+    setup = do
+        dflags <- G.getSessionDynFlags
+        void $ G.setSessionDynFlags (setFlags dflags)
+        return dflags
+    teardown = void . G.setSessionDynFlags
+
+withCmdFlags :: GhcMonad m => [GHCOption] -> m a -> m a
+withCmdFlags flags body = G.gbracket setup teardown (\_ -> body)
+  where
+    setup = do
+        dflags <- G.getSessionDynFlags >>= addCmdOpts flags
+        void $ G.setSessionDynFlags dflags
+        return dflags
+    teardown = void . G.setSessionDynFlags
+
+----------------------------------------------------------------
+
+-- | Set 'DynFlags' equivalent to "-w:".
+setNoWaringFlags :: DynFlags -> DynFlags
+setNoWaringFlags df = df { warningFlags = Gap.emptyWarnFlags}
+
+-- | Set 'DynFlags' equivalent to "-Wall".
+setAllWaringFlags :: DynFlags -> DynFlags
+setAllWaringFlags df = df { warningFlags = allWarningFlags }
+
+allWarningFlags :: Gap.WarnFlags
+allWarningFlags = unsafePerformIO $ do
+    G.runGhc (Just libdir) $ do
+        df <- G.getSessionDynFlags
+        df' <- addCmdOpts ["-Wall"] df
+        return $ G.warningFlags df'
+
+----------------------------------------------------------------
+
+-- | Set 'DynFlags' equivalent to "-fno-max-relevant-bindings".
+setNoMaxRelevantBindings :: DynFlags -> DynFlags
+#if __GLASGOW_HASKELL__ >= 708
+setNoMaxRelevantBindings df = df { maxRelevantBinds = Nothing }
+#else
+setNoMaxRelevantBindings = id
+#endif

Language/Haskell/GhcMod/FillSig.hs

@@ -1,10 +1,7 @@
 {-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies, FlexibleInstances, CPP #-}
 
 module Language.Haskell.GhcMod.FillSig (
-    fillSig
+    sig
-  , sig
-  , refineVar
-  , refine
   ) where
 
 import Data.Char (isSymbol)
@@ -12,23 +9,16 @@ import Data.List (find, intercalate)
 import Exception (ghandle, SomeException(..))
 import GHC (GhcMonad, Id, ParsedModule(..), TypecheckedModule(..), DynFlags, SrcSpan, Type, GenLocated(L))
 import qualified GHC as G
-import Language.Haskell.GhcMod.GHCApi
 import qualified Language.Haskell.GhcMod.Gap as Gap
 import Language.Haskell.GhcMod.Convert
 import Language.Haskell.GhcMod.Monad
 import Language.Haskell.GhcMod.SrcUtils
 import Language.Haskell.GhcMod.Types
-import MonadUtils (liftIO)
+import CoreMonad (liftIO)
 import Outputable (PprStyle)
 import qualified Type as Ty
 import qualified HsBinds as Ty
 import qualified Class as Ty
-#if __GLASGOW_HASKELL__ >= 706
-import OccName (occName)
-#else
-import OccName (OccName)
-import RdrName (rdrNameOcc)
-#endif
 import qualified Language.Haskell.Exts.Annotated as HE
 
 ----------------------------------------------------------------
@@ -40,24 +30,14 @@ data SigInfo = Signature SrcSpan [G.RdrName] (G.HsType G.RdrName)
              | InstanceDecl SrcSpan G.Class
 
 -- Signature for fallback operation via haskell-src-exts
-data HESigInfo = HESignature HE.SrcSpan [HE.Name HE.SrcSpanInfo] (HE.Type HE.SrcSpanInfo) 
+data HESigInfo = HESignature HE.SrcSpan [HE.Name HE.SrcSpanInfo] (HE.Type HE.SrcSpanInfo)
 
 -- | Create a initial body from a signature.
-fillSig :: Options
+sig :: IOish m
-        -> Cradle
+    => FilePath     -- ^ A target file.
-        -> FilePath     -- ^ A target file.
-        -> Int          -- ^ Line number.
-        -> Int          -- ^ Column number.
-        -> IO String
-fillSig opt cradle file lineNo colNo = runGhcMod opt $ do
-    initializeFlagsWithCradle opt cradle
-    sig file lineNo colNo
-
--- | Create a initial body from a signature.
-sig :: FilePath     -- ^ A target file.
     -> Int          -- ^ Line number.
     -> Int          -- ^ Column number.
-    -> GhcMod String
+    -> GhcModT m String
 sig file lineNo colNo = ghandle handler body
   where
     body = inModuleContext file $ \dflag style -> do
@@ -69,13 +49,13 @@ sig file lineNo colNo = ghandle handler body
           InstanceDecl loc cls -> do
              ("instance", fourInts loc, map (\x -> initialBody dflag style (G.idType x) x)
                                             (Ty.classMethods cls))
-            
+
     handler (SomeException _) = do
       opt <- options
       -- Code cannot be parsed by ghc module
       -- Fallback: try to get information via haskell-src-exts
       whenFound opt (getSignatureFromHE file lineNo colNo) $
-        \(HESignature loc names ty) -> 
+        \(HESignature loc names ty) ->
            ("function", fourIntsHE loc, map (initialBody undefined undefined ty) names)
 
 ----------------------------------------------------------------
@@ -94,32 +74,9 @@ getSignature modSum lineNo colNo = do
         -- We found an instance declaration
         TypecheckedModule{tm_renamed_source = Just tcs
                          ,tm_checked_module_info = minfo} <- G.typecheckModule p
-        case listifyRenamedSpans tcs (lineNo, colNo) :: [G.LInstDecl G.Name] of
+        case Gap.getClass $ listifyRenamedSpans tcs (lineNo, colNo) of
-          -- Instance declarations of sort 'instance F (G a)'
+            Just (clsName,loc) -> obtainClassInfo minfo clsName loc
-#if __GLASGOW_HASKELL__ >= 708
+            Nothing            -> return Nothing
-          [L loc (G.ClsInstD (G.ClsInstDecl {G.cid_poly_ty =
-            (L _ (G.HsForAllTy _ _ _ (L _ (G.HsAppTy (L _ (G.HsTyVar clsName)) _))))}))] ->
-#elif __GLASGOW_HASKELL__ >= 706
-          [L loc (G.ClsInstD
-            (L _ (G.HsForAllTy _ _ _ (L _ (G.HsAppTy (L _ (G.HsTyVar clsName)) _)))) _ _ _)] ->
-#else
-          [L loc (G.InstDecl
-            (L _ (G.HsForAllTy _ _ _ (L _ (G.HsAppTy (L _ (G.HsTyVar clsName)) _)))) _ _ _)] ->
-#endif
-               obtainClassInfo minfo clsName loc
-          -- Instance declarations of sort 'instance F G' (no variables)
-#if __GLASGOW_HASKELL__ >= 708
-          [L loc (G.ClsInstD (G.ClsInstDecl {G.cid_poly_ty =
-            (L _ (G.HsAppTy (L _ (G.HsTyVar clsName)) _))}))] ->
-#elif __GLASGOW_HASKELL__ >= 706
-          [L loc (G.ClsInstD
-            (L _ (G.HsAppTy (L _ (G.HsTyVar clsName)) _)) _ _ _)] ->
-#else
-          [L loc (G.InstDecl
-            (L _ (G.HsAppTy (L _ (G.HsTyVar clsName)) _)) _ _ _)] ->
-#endif
-               obtainClassInfo minfo clsName loc
-          _ -> return Nothing
       _ -> return Nothing
   where obtainClassInfo :: GhcMonad m => G.ModuleInfo -> G.Name -> SrcSpan -> m (Maybe SigInfo)
         obtainClassInfo minfo clsName loc = do
@@ -173,7 +130,7 @@ class FnArgsInfo ty name | ty -> name, name -> ty where
   getFnArgs :: ty -> [FnArg]
 
 instance FnArgsInfo (G.HsType G.RdrName) (G.RdrName) where
-  getFnName dflag style name = showOccName dflag style $ occName name
+  getFnName dflag style name = showOccName dflag style $ Gap.occName name
   getFnArgs (G.HsForAllTy _ _ _ (L _ iTy))  = getFnArgs iTy
   getFnArgs (G.HsParTy (L _ iTy))           = getFnArgs iTy
   getFnArgs (G.HsFunTy (L _ lTy) (L _ rTy)) = (if fnarg lTy then FnArgFunction else FnArgNormal):getFnArgs rTy
@@ -184,11 +141,6 @@ instance FnArgsInfo (G.HsType G.RdrName) (G.RdrName) where
                            _                              -> False
   getFnArgs _ = []
 
-#if __GLASGOW_HASKELL__ < 706
-occName :: G.RdrName -> OccName
-occName = rdrNameOcc
-#endif
-
 instance FnArgsInfo (HE.Type HE.SrcSpanInfo) (HE.Name HE.SrcSpanInfo) where
   getFnName _ _ (HE.Ident  _ s) = s
   getFnName _ _ (HE.Symbol _ s) = s
@@ -229,23 +181,13 @@ isSymbolName []    = error "This should never happen"
 -- REWRITE A HOLE / UNDEFINED VIA A FUNCTION
 ----------------------------------------------------------------
 
--- | Create a initial body from a signature.
+{-
-refineVar :: Options
+refine :: IOish m
-          -> Cradle
+       => FilePath     -- ^ A target file.
-          -> FilePath     -- ^ A target file.
-          -> Int          -- ^ Line number.
-          -> Int          -- ^ Column number.
-          -> Expression   -- ^ A Haskell expression.
-          -> IO String
-refineVar opt cradle file lineNo colNo e = runGhcMod opt $ do
-    initializeFlagsWithCradle opt cradle
-    refine file lineNo colNo e
-
-refine :: FilePath     -- ^ A target file.
        -> Int          -- ^ Line number.
        -> Int          -- ^ Column number.
        -> Expression   -- ^ A Haskell expression.
-       -> GhcMod String
+       -> GhcModT m String
 refine file lineNo colNo expr = ghandle handler body
   where
     body = inModuleContext file $ \dflag style -> do
@@ -273,3 +215,4 @@ findVar modSum lineNo colNo = do
    case listifyParsedSpans ps (lineNo, colNo) :: [G.LHsExpr G.RdrName] of
      (L loc (G.HsVar _)):_ -> return $ Just loc
      _                     -> return Nothing
+-}

Language/Haskell/GhcMod/Find.hs

@@ -31,11 +31,11 @@ type Symbol = String
 newtype SymMdlDb = SymMdlDb (Map Symbol [ModuleString])
 
 -- | Finding modules to which the symbol belong.
-findSymbol :: Symbol -> GhcMod String
+findSymbol :: IOish m => Symbol -> GhcModT m String
 findSymbol sym = convert' =<< lookupSym sym <$> getSymMdlDb
 
 -- | Creating 'SymMdlDb'.
-getSymMdlDb :: GhcMod SymMdlDb
+getSymMdlDb :: IOish m => GhcModT m SymMdlDb
 getSymMdlDb = do
     sm <- G.getSessionDynFlags >>= browseAll
 #if MIN_VERSION_containers(0,5,0)

Language/Haskell/GhcMod/Flag.hs

@@ -2,12 +2,12 @@ module Language.Haskell.GhcMod.Flag where
 
 import qualified Language.Haskell.GhcMod.Gap as Gap
 import Language.Haskell.GhcMod.Convert
-import Language.Haskell.GhcMod.Types
+import Language.Haskell.GhcMod.Monad
 
 -- | Listing GHC flags. (e.g -fno-warn-orphans)
 
-listFlags :: Options -> IO String
+flags :: IOish m => GhcModT m String
-listFlags opt = return $ convert opt [ "-f" ++ prefix ++ option
+flags = convert' [ "-f" ++ prefix ++ option
-                                     | option <- Gap.fOptions
+                 | option <- Gap.fOptions
-                                     , prefix <- ["","no-"]
+                 , prefix <- ["","no-"]
-                                     ]
+                 ]

Language/Haskell/GhcMod/GHCApi.hs

@@ -1,214 +1,87 @@
 {-# LANGUAGE ScopedTypeVariables, RecordWildCards, CPP #-}
 
 module Language.Haskell.GhcMod.GHCApi (
-    withGHC
+    ghcPkgDb
-  , withGHC'
+  , package
-  , initializeFlagsWithCradle
+  , modules
-  , setTargetFiles
+  , findModule
-  , getDynamicFlags
+  , moduleInfo
-  , getSystemLibDir
+  , localModuleInfo
-  , withDynFlags
+  , bindings
-  , withCmdFlags
-  , setNoWaringFlags
-  , setAllWaringFlags
-  , setNoMaxRelevantBindings
   ) where
 
-import Language.Haskell.GhcMod.CabalApi
-import Language.Haskell.GhcMod.GHCChoice
 import Language.Haskell.GhcMod.GhcPkg
+import Language.Haskell.GhcMod.DynFlags
+import Language.Haskell.GhcMod.Types
 
 import Control.Applicative ((<$>))
-import Control.Monad (forM, void)
+import Distribution.Package (InstalledPackageId(..))
-import Data.Maybe (isJust, fromJust)
+import qualified Data.Map as M
-import Exception (ghandle, SomeException(..))
+import GHC (DynFlags(..))
-import GHC (DynFlags(..), GhcLink(..), HscTarget(..), LoadHowMuch(..))
 import qualified GHC as G
 import GhcMonad
-import GHC.Paths (libdir)
+import qualified Packages as G
-import qualified Language.Haskell.GhcMod.Gap as Gap
+import qualified Module as G
-import Language.Haskell.GhcMod.Types
+import qualified OccName as G
-import System.Exit (exitSuccess)
-import System.IO (hPutStr, hPrint, stderr)
-import System.IO.Unsafe (unsafePerformIO)
 
 ----------------------------------------------------------------
+-- get Packages,Modules,Bindings
 
--- | Obtaining the directory for system libraries.
+ghcPkgDb :: GhcMonad m => m PkgDb
-getSystemLibDir :: IO (Maybe FilePath)
+ghcPkgDb = M.fromList <$>
-getSystemLibDir = return $ Just libdir
+    maybe [] (map toKv . filterInternal) <$> pkgDatabase <$> G.getSessionDynFlags
+ where
+    toKv pkg = (fromInstalledPackageId $ G.installedPackageId pkg, pkg)
+    filterInternal =
+        filter ((/= InstalledPackageId "builtin_rts") . G.installedPackageId)
 
-----------------------------------------------------------------
+package :: G.PackageConfig -> Package
+package = fromInstalledPackageId . G.installedPackageId
 
--- | Converting the 'Ghc' monad to the 'IO' monad.
+modules :: G.PackageConfig -> [ModuleString]
-withGHC :: FilePath  -- ^ A target file displayed in an error message.
+modules = map G.moduleNameString . G.exposedModules
-        -> Ghc a -- ^ 'Ghc' actions created by the Ghc utilities.
-        -> IO a
-withGHC file body = ghandle ignore $ withGHC' body
-  where
-    ignore :: SomeException -> IO a
-    ignore e = do
-        hPutStr stderr $ file ++ ":0:0:Error:"
-        hPrint stderr e
-        exitSuccess
 
-withGHC' :: Ghc a -> IO a
+findModule :: ModuleString -> PkgDb -> [Package]
-withGHC' body = do
+findModule m db = do
-    mlibdir <- getSystemLibDir
+  M.elems $ package `M.map` (containsModule `M.filter` db)
-    G.runGhc mlibdir $ do
+ where
-        dflags <- G.getSessionDynFlags
+    containsModule :: G.PackageConfig -> Bool
-        G.defaultCleanupHandler dflags body
+    containsModule pkgConf =
-
+        G.mkModuleName m `elem` G.exposedModules pkgConf
-----------------------------------------------------------------
-
-importDirs :: [IncludeDir]
-importDirs = [".","..","../..","../../..","../../../..","../../../../.."]
-
-data Build = CabalPkg | SingleFile deriving Eq
-
--- | Initialize the 'DynFlags' relating to the compilation of a single
--- file or GHC session according to the 'Cradle' and 'Options'
--- provided.
-initializeFlagsWithCradle :: GhcMonad m
-        => Options
-        -> Cradle
-        -> m ()
-initializeFlagsWithCradle opt cradle
-  | cabal     = withCabal |||> withSandbox
-  | otherwise = withSandbox
-  where
-    mCradleFile = cradleCabalFile cradle
-    cabal = isJust mCradleFile
-    ghcopts = ghcOpts opt
-    withCabal = do
-        pkgDesc <- liftIO $ parseCabalFile $ fromJust mCradleFile
-        compOpts <- liftIO $ getCompilerOptions ghcopts cradle pkgDesc
-        initSession CabalPkg opt compOpts
-    withSandbox = initSession SingleFile opt compOpts
-      where
-        pkgOpts = ghcDbStackOpts $ cradlePkgDbStack cradle
-        compOpts
-          | null pkgOpts = CompilerOptions ghcopts importDirs []
-          | otherwise    = CompilerOptions (ghcopts ++ pkgOpts) [wdir,rdir] []
-        wdir = cradleCurrentDir cradle
-        rdir = cradleRootDir    cradle
-
-----------------------------------------------------------------
-
-initSession :: GhcMonad m
-            => Build
-            -> Options
-            -> CompilerOptions
-            -> m ()
-initSession build Options {..} CompilerOptions {..} = do
-    df <- G.getSessionDynFlags
-    void $ G.setSessionDynFlags =<< (addCmdOpts ghcOptions
-      $ setLinkerOptions
-      $ setIncludeDirs includeDirs
-      $ setBuildEnv build
-      $ setEmptyLogger
-      $ Gap.addPackageFlags depPackages df)
-
-setEmptyLogger :: DynFlags -> DynFlags
-setEmptyLogger df = Gap.setLogAction df $ \_ _ _ _ _ -> return ()
-
-----------------------------------------------------------------
-
--- we don't want to generate object code so we compile to bytecode
--- (HscInterpreted) which implies LinkInMemory
--- HscInterpreted
-setLinkerOptions :: DynFlags -> DynFlags
-setLinkerOptions df = df {
-    ghcLink   = LinkInMemory
-  , hscTarget = HscInterpreted
-  }
-
-setIncludeDirs :: [IncludeDir] -> DynFlags -> DynFlags
-setIncludeDirs idirs df = df { importPaths = idirs }
-
-setBuildEnv :: Build -> DynFlags -> DynFlags
-setBuildEnv build = setHideAllPackages build . setCabalPackage build
-
--- At the moment with this option set ghc only prints different error messages,
--- suggesting the user to add a hidden package to the build-depends in his cabal
--- file for example
-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)
-  where
-    tfst (a,_,_) = a
-
-----------------------------------------------------------------
-
--- | Set the files as targets and load them.
-setTargetFiles :: (GhcMonad m) => [FilePath] -> m ()
-setTargetFiles files = do
-    targets <- forM files $ \file -> G.guessTarget file Nothing
-    G.setTargets targets
-    void $ G.load LoadAllTargets
-
-----------------------------------------------------------------
-
--- | Return the 'DynFlags' currently in use in the GHC session.
-getDynamicFlags :: IO DynFlags
-getDynamicFlags = do
-    mlibdir <- getSystemLibDir
-    G.runGhc mlibdir G.getSessionDynFlags
-
-withDynFlags :: GhcMonad m
-             => (DynFlags -> DynFlags)
-             -> m a
-             -> m a
-withDynFlags setFlags body = G.gbracket setup teardown (\_ -> body)
-  where
-    setup = do
-        dflags <- G.getSessionDynFlags
-        void $ G.setSessionDynFlags (setFlags dflags)
-        return dflags
-    teardown = void . G.setSessionDynFlags
-
-withCmdFlags :: GhcMonad m => [GHCOption] -> m a -> m a
-withCmdFlags flags body = G.gbracket setup teardown (\_ -> body)
-  where
-    setup = do
-        dflags <- G.getSessionDynFlags >>= addCmdOpts flags
-        void $ G.setSessionDynFlags dflags
-        return dflags
-    teardown = void . G.setSessionDynFlags
-
-----------------------------------------------------------------
-
--- | Set 'DynFlags' equivalent to "-w:".
-setNoWaringFlags :: DynFlags -> DynFlags
-setNoWaringFlags df = df { warningFlags = Gap.emptyWarnFlags}
-
--- | Set 'DynFlags' equivalent to "-Wall".
-setAllWaringFlags :: DynFlags -> DynFlags
-setAllWaringFlags df = df { warningFlags = allWarningFlags }
-
--- | Set 'DynFlags' equivalent to "-fno-max-relevant-bindings".
-setNoMaxRelevantBindings :: DynFlags -> DynFlags
-#if __GLASGOW_HASKELL__ >= 708
-setNoMaxRelevantBindings df = df { maxRelevantBinds = Nothing }
-#else
-setNoMaxRelevantBindings = id
-#endif
 
 
-allWarningFlags :: Gap.WarnFlags
+ghcPkgId :: Package -> G.PackageId
-allWarningFlags = unsafePerformIO $ do
+ghcPkgId (name,_,_) =
-    mlibdir <- getSystemLibDir
+    -- TODO: Adding the package version too breaks 'findModule' for some reason
-    G.runGhc mlibdir $ do
+    -- this isn't a big deal since in the common case where we're in a cabal
-        df <- G.getSessionDynFlags
+    -- project we just use cabal's view of package dependencies anyways so we're
-        df' <- addCmdOpts ["-Wall"] df
+    -- guaranteed to only have one version of each package exposed. However when
-        return $ G.warningFlags df'
+    -- we're operating without a cabal project this will probaly cause trouble.
+    G.stringToPackageId name
+
+type Binding = String
+
+-- | @moduleInfo mpkg module@. @mpkg@ should be 'Nothing' iff. moduleInfo
+-- should look for @module@ in the working directory.
+--
+-- To map a 'ModuleString' to a package see 'findModule'
+moduleInfo :: GhcMonad m
+           => Maybe Package
+           -> ModuleString
+           -> m (Maybe G.ModuleInfo)
+moduleInfo mpkg mdl = do
+    let mdlName = G.mkModuleName mdl
+        mfsPkgId = G.packageIdFS . ghcPkgId <$> mpkg
+    loadLocalModule
+    G.findModule mdlName mfsPkgId >>= G.getModuleInfo
+ where
+   loadLocalModule = case mpkg of
+       Just _ -> return ()
+       Nothing -> setTargetFiles [mdl]
+
+localModuleInfo :: GhcMonad m => ModuleString -> m (Maybe G.ModuleInfo)
+localModuleInfo mdl = moduleInfo Nothing mdl
+
+bindings :: G.ModuleInfo -> [Binding]
+bindings minfo = do
+  map (G.occNameString . G.getOccName) $ G.modInfoExports minfo

Language/Haskell/GhcMod/Gap.hs

@@ -33,6 +33,12 @@ module Language.Haskell.GhcMod.Gap (
   , fileModSummary
   , WarnFlags
   , emptyWarnFlags
+  , benchmarkBuildInfo
+  , benchmarkTargets
+  , toModuleString
+  , GLMatch
+  , getClass
+  , occName
   ) where
 
 import Control.Applicative hiding (empty)
@@ -58,6 +64,7 @@ import StringBuffer
 import TcType
 import Var (varType)
 
+import qualified Distribution.PackageDescription as P
 import qualified InstEnv
 import qualified Pretty
 import qualified StringBuffer as SB
@@ -76,10 +83,12 @@ import GHC hiding (ClsInst)
 import GHC hiding (Instance)
 import Control.Arrow hiding ((<+>))
 import Data.Convertible
+import RdrName (rdrNameOcc)
 #endif
 
 #if __GLASGOW_HASKELL__ >= 704
 import qualified Data.IntSet as I (IntSet, empty)
+import qualified Distribution.ModuleName as M (ModuleName,toFilePath)
 #endif
 
 ----------------------------------------------------------------
@@ -280,8 +289,10 @@ class HasType a where
 
 instance HasType (LHsBind Id) where
 #if __GLASGOW_HASKELL__ >= 708
-    getType _ (L spn FunBind{fun_matches = MG _ in_tys out_typ}) = return $ Just (spn, typ)
+    getType _ (L spn FunBind{fun_matches = m}) = return $ Just (spn, typ)
-      where typ = mkFunTys in_tys out_typ
+      where in_tys = mg_arg_tys m
+            out_typ = mg_res_ty m
+            typ = mkFunTys in_tys out_typ
 #else
     getType _ (L spn FunBind{fun_matches = MatchGroup _ typ}) = return $ Just (spn, typ)
 #endif
@@ -396,3 +407,55 @@ type WarnFlags = [WarningFlag]
 emptyWarnFlags :: WarnFlags
 emptyWarnFlags = []
 #endif
+
+----------------------------------------------------------------
+----------------------------------------------------------------
+
+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)
+#else
+type GLMatch = LMatch RdrName
+#endif
+
+getClass :: [LInstDecl Name] -> Maybe (Name, SrcSpan)
+#if __GLASGOW_HASKELL__ >= 708
+-- Instance declarations of sort 'instance F (G a)'
+getClass [L loc (ClsInstD (ClsInstDecl {cid_poly_ty = (L _ (HsForAllTy _ _ _ (L _ (HsAppTy (L _ (HsTyVar className)) _))))}))] = Just (className, loc)
+-- Instance declarations of sort 'instance F G' (no variables)
+getClass [L loc (ClsInstD (ClsInstDecl {cid_poly_ty = (L _ (HsAppTy (L _ (HsTyVar className)) _))}))] = Just (className, loc)
+#elif __GLASGOW_HASKELL__ >= 706
+getClass [L loc (ClsInstD (L _ (HsForAllTy _ _ _ (L _ (HsAppTy (L _ (HsTyVar className)) _)))) _ _ _)] = Just (className, loc)
+getClass[L loc (ClsInstD (L _ (HsAppTy (L _ (HsTyVar className)) _)) _ _ _)] = Just (className, loc)
+#else
+getClass [L loc (InstDecl (L _ (HsForAllTy _ _ _ (L _ (HsAppTy (L _ (HsTyVar className)) _)))) _ _ _)] = Just (className, loc)
+getClass [L loc (InstDecl (L _ (HsAppTy (L _ (HsTyVar className)) _)) _ _ _)] = Just (className, loc)
+#endif
+getClass _ = Nothing
+
+#if __GLASGOW_HASKELL__ < 706
+occName :: RdrName -> OccName
+occName = rdrNameOcc
+#endif

Language/Haskell/GhcMod/Ghc.hs

@@ -1,31 +1,10 @@
 module Language.Haskell.GhcMod.Ghc (
-  -- * Converting the 'Ghc' monad to the 'IO' monad
-    withGHC
-  , withGHC'
-  -- * 'Ghc' utilities
-  , boot
-  , browse
-  , check
-  , info
-  , types
-  , splits
-  , sig
-  , refine
-  , modules
   -- * 'SymMdlDb'
-  , Symbol
+    Symbol
   , SymMdlDb
   , getSymMdlDb
   , lookupSym
   , lookupSym'
   ) where
 
-import Language.Haskell.GhcMod.Boot
-import Language.Haskell.GhcMod.Browse
-import Language.Haskell.GhcMod.Check
 import Language.Haskell.GhcMod.Find
-import Language.Haskell.GhcMod.GHCApi
-import Language.Haskell.GhcMod.Info
-import Language.Haskell.GhcMod.List
-import Language.Haskell.GhcMod.FillSig
-import Language.Haskell.GhcMod.CaseSplit

Language/Haskell/GhcMod/Info.hs

@@ -1,7 +1,5 @@
 module Language.Haskell.GhcMod.Info (
-    infoExpr
+    info
-  , info
-  , typeExpr
   , types
   ) where
 
@@ -13,7 +11,6 @@ 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.GHCApi
 import Language.Haskell.GhcMod.Gap (HasType(..))
 import qualified Language.Haskell.GhcMod.Gap as Gap
 import Language.Haskell.GhcMod.Monad
@@ -24,19 +21,10 @@ import Language.Haskell.GhcMod.Convert
 ----------------------------------------------------------------
 
 -- | Obtaining information of a target expression. (GHCi's info:)
-infoExpr :: Options
+info :: IOish m
-         -> Cradle
+     => FilePath     -- ^ A target file.
-         -> FilePath     -- ^ A target file.
-         -> Expression   -- ^ A Haskell expression.
-         -> IO String
-infoExpr opt cradle file expr = runGhcMod opt $ do
-    initializeFlagsWithCradle opt cradle
-    info file expr
-
--- | Obtaining information of a target expression. (GHCi's info:)
-info :: FilePath     -- ^ A target file.
      -> Expression   -- ^ A Haskell expression.
-     -> GhcMod String
+     -> GhcModT m String
 info file expr = do
     opt <- options
     convert opt <$> ghandle handler body
@@ -49,21 +37,11 @@ info file expr = do
 ----------------------------------------------------------------
 
 -- | Obtaining type of a target expression. (GHCi's type:)
-typeExpr :: Options
+types :: IOish m
-         -> Cradle
+      => FilePath     -- ^ A target file.
-         -> FilePath     -- ^ A target file.
-         -> Int          -- ^ Line number.
-         -> Int          -- ^ Column number.
-         -> IO String
-typeExpr opt cradle file lineNo colNo = runGhcMod opt $ do
-    initializeFlagsWithCradle opt cradle
-    types file lineNo colNo
-
--- | Obtaining type of a target expression. (GHCi's type:)
-types :: FilePath     -- ^ A target file.
       -> Int          -- ^ Line number.
       -> Int          -- ^ Column number.
-      -> GhcMod String
+      -> GhcModT m String
 types file lineNo colNo = do
     opt <- options
     convert opt <$> ghandle handler body
@@ -85,4 +63,3 @@ getSrcSpanType modSum lineNo colNo = do
     ets <- mapM (getType tcm) es
     pts <- mapM (getType tcm) ps
     return $ catMaybes $ concat [ets, bts, pts]
-

Language/Haskell/GhcMod/Internal.hs

@@ -16,11 +16,10 @@ module Language.Haskell.GhcMod.Internal (
   , cabalDependPackages
   , cabalSourceDirs
   , cabalAllTargets
+  -- * GHC.Paths
+  , ghcLibDir
   -- * IO
-  , getSystemLibDir
   , getDynamicFlags
-  -- * Initializing 'DynFlags'
-  , initializeFlagsWithCradle
   -- * Targets
   , setTargetFiles
   -- * Logging
@@ -35,8 +34,14 @@ module Language.Haskell.GhcMod.Internal (
   , (|||>)
   ) where
 
+import GHC.Paths (libdir)
+
 import Language.Haskell.GhcMod.CabalApi
-import Language.Haskell.GhcMod.GHCApi
+import Language.Haskell.GhcMod.DynFlags
 import Language.Haskell.GhcMod.GHCChoice
 import Language.Haskell.GhcMod.Logger
 import Language.Haskell.GhcMod.Types
+
+-- | Obtaining the directory for ghc system libraries.
+ghcLibDir :: FilePath
+ghcLibDir = libdir

Language/Haskell/GhcMod/Lang.hs

@@ -1,10 +1,10 @@
 module Language.Haskell.GhcMod.Lang where
 
 import DynFlags (supportedLanguagesAndExtensions)
-import Language.Haskell.GhcMod.Types
 import Language.Haskell.GhcMod.Convert
+import Language.Haskell.GhcMod.Monad
 
 -- | Listing language extensions.
 
-listLanguages :: Options -> IO String
+languages :: IOish m => GhcModT m String
-listLanguages opt = return $ convert opt supportedLanguagesAndExtensions
+languages = convert' supportedLanguagesAndExtensions

Language/Haskell/GhcMod/Lint.hs

@@ -1,19 +1,21 @@
 module Language.Haskell.GhcMod.Lint where
 
-import Control.Applicative ((<$>))
+import Exception (ghandle)
-import Control.Exception (handle, SomeException(..))
+import Control.Exception (SomeException(..))
+import CoreMonad (liftIO)
 import Language.Haskell.GhcMod.Logger (checkErrorPrefix)
 import Language.Haskell.GhcMod.Convert
-import Language.Haskell.GhcMod.Types
+import Language.Haskell.GhcMod.Monad
 import Language.Haskell.HLint (hlint)
 
 -- | Checking syntax of a target file using hlint.
 --   Warnings and errors are returned.
-lintSyntax :: Options
+lint :: IOish m
-           -> FilePath  -- ^ A target file.
+     => FilePath  -- ^ A target file.
-           -> IO String
+     -> GhcModT m String
-lintSyntax opt file = handle handler $ pack <$> hlint (file : "--quiet" : hopts)
+lint file = do
-  where
+  opt <- options
-    pack = convert opt . map (init . show) -- init drops the last \n.
+  ghandle handler . pack =<< (liftIO $ hlint $ file : "--quiet" : hlintOpts opt)
-    hopts = hlintOpts opt
+ where
+    pack = convert' . map (init . show) -- init drops the last \n.
     handler (SomeException e) = return $ checkErrorPrefix ++ show e ++ "\n"

Language/Haskell/GhcMod/List.hs

@@ -1,4 +1,4 @@
-module Language.Haskell.GhcMod.List (listModules, modules) where
+module Language.Haskell.GhcMod.List (modules) where
 
 import Control.Applicative ((<$>))
 import Control.Exception (SomeException(..))
@@ -6,18 +6,13 @@ import Data.List (nub, sort)
 import qualified GHC as G
 import Language.Haskell.GhcMod.Monad
 import Language.Haskell.GhcMod.Convert
-import Language.Haskell.GhcMod.Types
 import Packages (pkgIdMap, exposedModules, sourcePackageId, display)
 import UniqFM (eltsUFM)
 
 ----------------------------------------------------------------
 
 -- | Listing installed modules.
-listModules :: Options -> Cradle -> IO String
+modules :: IOish m => GhcModT m String
-listModules opt _ = runGhcMod opt $ modules
-
--- | Listing installed modules.
-modules :: GhcMod String
 modules = do
     opt <- options
     convert opt . (arrange opt) <$> (getModules `G.gcatch` handler)

Language/Haskell/GhcMod/Logger.hs

@@ -6,7 +6,7 @@ module Language.Haskell.GhcMod.Logger (
   ) where
 
 import Bag (Bag, bagToList)
-import Control.Applicative ((<$>),(*>))
+import Control.Applicative ((<$>))
 import CoreMonad (liftIO)
 import Data.IORef (IORef, newIORef, readIORef, writeIORef, modifyIORef)
 import Data.List (isPrefixOf)
@@ -17,11 +17,10 @@ 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.GHCApi (withDynFlags, withCmdFlags)
+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 (Options(..))
 import Outputable (PprStyle, SDoc)
 import System.FilePath (normalise)
 
@@ -29,35 +28,46 @@ import System.FilePath (normalise)
 
 type Builder = [String] -> [String]
 
-newtype LogRef = LogRef (IORef Builder)
+data Log = Log [String] Builder
+
+newtype LogRef = LogRef (IORef Log)
+
+emptyLog :: Log
+emptyLog = Log [] id
 
 newLogRef :: IO LogRef
-newLogRef = LogRef <$> newIORef id
+newLogRef = LogRef <$> newIORef emptyLog
 
-readAndClearLogRef :: LogRef -> GhcMod String
+readAndClearLogRef :: IOish m => LogRef -> GhcModT m String
 readAndClearLogRef (LogRef ref) = do
-    b <- liftIO $ readIORef ref
+    Log _ b <- liftIO $ readIORef ref
-    liftIO $ writeIORef ref id
+    liftIO $ writeIORef ref emptyLog
     convert' (b [])
 
 appendLogRef :: DynFlags -> LogRef -> DynFlags -> Severity -> SrcSpan -> PprStyle -> SDoc -> IO ()
-appendLogRef df (LogRef ref) _ sev src style msg = do
+appendLogRef df (LogRef ref) _ sev src style msg = modifyIORef ref update
-        let !l = ppMsg src sev df style msg
+  where
-        modifyIORef ref (\b -> b . (l:))
+    l = ppMsg src sev df style msg
+    update lg@(Log ls b)
+      | l `elem` ls = lg
+      | otherwise   = Log (l:ls) (b . (l:))
 
 ----------------------------------------------------------------
 
 -- | 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 :: (DynFlags -> DynFlags)
+withLogger :: IOish m
-           -> GhcMod ()
+           => (DynFlags -> DynFlags)
-           -> GhcMod (Either String String)
+           -> GhcModT m ()
+           -> GhcModT m (Either String String)
 withLogger setDF body = ghandle sourceError $ do
     logref <- liftIO $ newLogRef
     wflags <- filter ("-fno-warn" `isPrefixOf`) . ghcOpts <$> options
     withDynFlags (setLogger logref . setDF) $ do
-        withCmdFlags wflags $ do body *> (Right <$> readAndClearLogRef logref)
+        withCmdFlags wflags $ do
+            body
+            Right <$> readAndClearLogRef logref
   where
     setLogger logref df = Gap.setLogAction df $ appendLogRef df logref
 
@@ -65,7 +75,7 @@ withLogger setDF body = ghandle sourceError $ do
 ----------------------------------------------------------------
 
 -- | Converting 'SourceError' to 'String'.
-sourceError :: SourceError -> GhcMod (Either String String)
+sourceError :: IOish m => SourceError -> GhcModT m (Either String String)
 sourceError err = do
     dflags <- G.getSessionDynFlags
     style <- toGhcMod getStyle

Language/Haskell/GhcMod/Monad.hs

@@ -1,29 +1,54 @@
 {-# LANGUAGE CPP, GeneralizedNewtypeDeriving, FlexibleInstances #-}
-{-# LANGUAGE MultiParamTypeClasses, RankNTypes, TypeFamilies #-}
+{-# LANGUAGE FlexibleContexts, MultiParamTypeClasses, RankNTypes #-}
+{-# LANGUAGE TypeFamilies, UndecidableInstances, RecordWildCards #-}
+{-# LANGUAGE StandaloneDeriving #-}
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 
 module Language.Haskell.GhcMod.Monad (
    GhcMod
+ , runGhcMod
+ , liftGhcMod
+ , GhcModT
+ , IOish
  , GhcModEnv(..)
  , GhcModWriter
  , GhcModState(..)
- , runGhcMod'
+ , runGhcModT'
- , runGhcMod
+ , runGhcModT
+ , newGhcModEnv
  , withErrorHandler
  , toGhcMod
  , options
+ , cradle
+ , Options(..)
+ , defaultOptions
  , module Control.Monad.Reader.Class
  , module Control.Monad.Writer.Class
  , module Control.Monad.State.Class
  ) where
 
-import Language.Haskell.GhcMod.Cradle
+#if __GLASGOW_HASKELL__ < 708
-import Language.Haskell.GhcMod.GHCApi
+-- 'CoreMonad.MonadIO' and 'Control.Monad.IO.Class.MonadIO' are different
+-- classes before ghc 7.8
+#define DIFFERENT_MONADIO 1
+
+-- RWST doen't have a MonadIO instance before ghc 7.8
+#define MONADIO_INSTANCES 1
+#endif
+
+
 import Language.Haskell.GhcMod.Types
+import Language.Haskell.GhcMod.Cradle
+import Language.Haskell.GhcMod.DynFlags
+import Language.Haskell.GhcMod.GhcPkg
+import Language.Haskell.GhcMod.GHCChoice
+import Language.Haskell.GhcMod.CabalApi
+import qualified Language.Haskell.GhcMod.Gap as Gap
 
 import DynFlags
 import Exception
 import GHC
+import qualified GHC as G
 import GHC.Paths (libdir)
 import GhcMonad
 #if __GLASGOW_HASKELL__ <= 702
@@ -36,23 +61,33 @@ import HscTypes
 -- So, RWST automatically becomes an instance of MonadIO.
 import MonadUtils
 
-#if __GLASGOW_HASKELL__ < 708
+#if DIFFERENT_MONADIO
--- To make RWST an instance of MonadIO.
 import Control.Monad.Trans.Class (lift)
+import qualified Control.Monad.IO.Class
 import Data.Monoid (Monoid)
 #endif
 
-import Control.Monad (liftM)
+import Control.Applicative (Alternative)
-import Control.Monad.Base (MonadBase,liftBase)
+import Control.Monad (MonadPlus, liftM, void)
+import Control.Monad.Base (MonadBase, liftBase)
+
 import Control.Monad.Reader.Class
 import Control.Monad.State.Class
-import Control.Monad.Trans.Control (MonadBaseControl(..), StM, liftBaseWith, control, liftBaseOp, liftBaseOp_)
+import Control.Monad.Trans.Class
-import Control.Monad.Trans.RWS.Lazy (RWST(..),runRWST)
+#if __GLASGOW_HASKELL__ < 708
+import Control.Monad.Trans.Maybe
+#endif
+import Control.Monad.Trans.Control (MonadBaseControl(..), StM, liftBaseWith,
+  control, liftBaseOp, liftBaseOp_)
+import Control.Monad.Trans.RWS.Lazy (RWST(..), runRWST)
 import Control.Monad.Writer.Class
+import Control.Monad.Error (Error(..), ErrorT(..), MonadError)
 
+import Data.Maybe (fromJust, isJust)
 import Data.IORef (IORef, readIORef, writeIORef, newIORef)
 import System.Exit (exitSuccess)
 import System.IO (hPutStr, hPrint, stderr)
+import System.Directory (getCurrentDirectory)
 
 ----------------------------------------------------------------
 
@@ -62,102 +97,268 @@ data GhcModEnv = GhcModEnv {
     , gmCradle     :: Cradle
     }
 
-data GhcModState = GhcModState
+data GhcModState = GhcModState deriving (Eq,Show,Read)
 
 defaultState :: GhcModState
 defaultState = GhcModState
 
 type GhcModWriter = ()
 
+data GhcModError = GMENoMsg
+                 | GMEString String
+                 | GMECabal
+                 | GMEGhc
+                   deriving (Eq,Show,Read)
+
+instance Error GhcModError where
+    noMsg = GMENoMsg
+    strMsg = GMEString
+
 ----------------------------------------------------------------
 
-newtype GhcMod a = GhcMod {
+type IOish m = (Functor m, MonadIO m, MonadBaseControl IO m)
-      unGhcMod :: RWST GhcModEnv GhcModWriter GhcModState IO a
+
+type GhcMod a = GhcModT (ErrorT GhcModError IO) a
+
+newtype GhcModT m a = GhcModT {
+      unGhcModT :: RWST GhcModEnv GhcModWriter GhcModState m a
     } deriving (Functor
-               ,Applicative
+               , Applicative
-               ,Monad
+               , Alternative
-               ,MonadIO
+               , Monad
-               ,MonadReader GhcModEnv
+               , MonadPlus
-               ,MonadWriter GhcModWriter
+               , MonadIO
-               ,MonadState GhcModState
+#if DIFFERENT_MONADIO
+               , Control.Monad.IO.Class.MonadIO
+#endif
+               , MonadReader GhcModEnv
+               , MonadWriter GhcModWriter
+               , MonadState GhcModState
+               , MonadTrans
                )
 
-#if __GLASGOW_HASKELL__ < 708
+deriving instance MonadError GhcModError m => MonadError GhcModError (GhcModT m)
+
+#if MONADIO_INSTANCES
 instance (Monoid w, MonadIO m) => MonadIO (RWST r w s m) where
---  liftIO :: MonadIO m => IO a -> m a
     liftIO = lift . liftIO
+
+instance (Error e, MonadIO m) => MonadIO (ErrorT e m) where
+    liftIO = lift . liftIO
+
+instance (MonadIO m) => MonadIO (MaybeT m) where
+    liftIO = lift . liftIO
+
 #endif
 
 ----------------------------------------------------------------
 
-runGhcMod' :: GhcModEnv
+-- | Initialize the 'DynFlags' relating to the compilation of a single
-          -> GhcModState
+-- file or GHC session according to the 'Cradle' and 'Options'
-          -> GhcMod a
+-- provided.
-          -> IO (a,(GhcModState, GhcModWriter))
+initializeFlagsWithCradle :: GhcMonad m
-runGhcMod' r s a = do
+        => Options
-  (a', s',w) <- runRWST (unGhcMod $ initGhcMonad (Just libdir) >> a) r s
+        -> Cradle
-  return (a',(s',w))
+        -> m ()
+initializeFlagsWithCradle opt c
+  | cabal     = withCabal |||> withSandbox
+  | otherwise = withSandbox
+  where
+    mCradleFile = cradleCabalFile c
+    cabal = isJust mCradleFile
+    ghcopts = ghcOpts opt
+    withCabal = do
+        pkgDesc <- liftIO $ parseCabalFile $ fromJust mCradleFile
+        compOpts <- liftIO $ getCompilerOptions ghcopts c 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 = cradleCurrentDir c
+        rdir = cradleRootDir    c
 
-
+initSession :: GhcMonad m
-runGhcMod :: Options -> GhcMod a -> IO a
+            => Build
-runGhcMod opt action = do
+            -> Options
-    session <- newIORef (error "empty session")
+            -> CompilerOptions
-    cradle <- findCradle
+            -> m ()
-    let env = GhcModEnv { gmGhcSession = session
+initSession build Options {..} CompilerOptions {..} = do
-                        , gmOptions = opt
+    df <- G.getSessionDynFlags
-                        , gmCradle = cradle }
+    void $ G.setSessionDynFlags =<< (addCmdOpts ghcOptions
-    (a,(_,_)) <- runGhcMod' env defaultState $ do
+      $ setModeSimple
-        dflags <- getSessionDynFlags
+      $ setIncludeDirs includeDirs
-        defaultCleanupHandler dflags $ do
+      $ setBuildEnv build
-            toGhcMod $ initializeFlagsWithCradle opt cradle
+      $ setEmptyLogger
-            action
+      $ Gap.addPackageFlags depPackages df)
-    return a
 
 ----------------------------------------------------------------
 
-withErrorHandler :: String -> GhcMod a -> GhcMod a
+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
+        }
+
+-- | Run a @GhcModT m@ computation, i.e. one with a custom underlying monad.
+--
+-- You probably don't want this, look at 'runGhcMod' instead.
+runGhcModT :: IOish m => Options -> GhcModT m a -> m a
+runGhcModT opt action = do
+    env <- liftBase $ newGhcModEnv opt =<< getCurrentDirectory
+    (a,(_,_)) <- runGhcModT' env defaultState $ do
+        dflags <- getSessionDynFlags
+        defaultCleanupHandler dflags $ do
+            initializeFlagsWithCradle opt (gmCradle env)
+            action
+    return a
+
+-- | Run a computation inside @GhcModT@ providing the RWST environment and
+-- initial state. This is a low level function, use it only if you know what to
+-- do with 'GhcModEnv' and 'GhcModState'.
+--
+-- You should probably look at 'runGhcModT' instead.
+runGhcModT' :: IOish m
+           => GhcModEnv
+           -> GhcModState
+           -> GhcModT m a
+           -> m (a,(GhcModState, GhcModWriter))
+runGhcModT' r s a = do
+  (a',s',w) <- runRWST (unGhcModT $ initGhcMonad (Just libdir) >> a) r s
+  return (a',(s',w))
+
+-- | Run a 'GhcMod' computation. If you want an underlying monad other than
+-- 'ErrorT e IO' you should look at 'runGhcModT'
+runGhcMod :: Options
+          -> GhcMod a
+          -> IO (Either GhcModError a)
+runGhcMod o a =
+  runErrorT $ runGhcModT o a
+
+liftErrorT :: IOish m => GhcModT m a -> GhcModT (ErrorT GhcModError m) a
+liftErrorT action =
+    GhcModT $ RWST $ \e s -> ErrorT $ Right <$> (runRWST $ unGhcModT action) e s
+
+-- | Lift @(GhcModT IO)@ into @GhcMod@, which is an alias for @GhcModT (ErrorT
+-- GhcModError IO)@.
+liftGhcMod :: GhcModT IO a -> GhcMod a
+liftGhcMod = liftErrorT
+
+----------------------------------------------------------------
+
+withErrorHandler :: IOish m => String -> GhcModT m a -> GhcModT m a
 withErrorHandler label = ghandle ignore
   where
-    ignore :: SomeException -> GhcMod a
+    ignore :: IOish m => SomeException -> GhcModT m a
     ignore e = liftIO $ do
         hPutStr stderr $ label ++ ":0:0:Error:"
         hPrint stderr e
         exitSuccess
 
-toGhcMod :: Ghc a -> GhcMod a
+-- | This is only a transitional mechanism don't use it for new code.
+toGhcMod :: IOish m => Ghc a -> GhcModT m a
 toGhcMod a = do
     s <- gmGhcSession <$> ask
     liftIO $ unGhc a $ Session s
 
 ----------------------------------------------------------------
 
-options :: GhcMod Options
+options :: IOish m => GhcModT m Options
 options = gmOptions <$> ask
 
-instance MonadBase IO GhcMod where
+cradle :: IOish m => GhcModT m Cradle
-    liftBase = GhcMod . liftBase
+cradle = gmCradle <$> ask
 
-instance MonadBaseControl IO GhcMod where
+instance (MonadBaseControl IO m) => MonadBase IO (GhcModT m) where
-    newtype StM GhcMod a = StGhcMod {
+    liftBase = GhcModT . liftBase
-          unStGhcMod :: StM (RWST GhcModEnv () GhcModState IO) a }
 
-    liftBaseWith f = GhcMod . liftBaseWith $ \runInBase ->
+instance (MonadBaseControl IO m) => MonadBaseControl IO (GhcModT m) where
-        f $ liftM StGhcMod . runInBase . unGhcMod
+    newtype StM (GhcModT m) a = StGhcMod {
+          unStGhcMod :: StM (RWST GhcModEnv GhcModWriter GhcModState m) a }
 
-    restoreM = GhcMod . restoreM . unStGhcMod
+    liftBaseWith f = GhcModT . liftBaseWith $ \runInBase ->
+        f $ liftM StGhcMod . runInBase . unGhcModT
+
+    restoreM = GhcModT . restoreM . unStGhcMod
     {-# INLINE liftBaseWith #-}
     {-# INLINE restoreM #-}
 
-instance GhcMonad GhcMod where
+-- GHC cannot prove the following instances to be decidable automatically using
-    getSession = liftIO . readIORef . gmGhcSession =<< ask
+-- the FlexibleContexts extension as they violate the second Paterson Condition,
-    setSession a = liftIO . flip writeIORef a . gmGhcSession =<< ask
+-- 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@
+--
+-- @
+-- { }
+-- @
+-- ∎
+
+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
 
 #if __GLASGOW_HASKELL__ >= 706
-instance HasDynFlags GhcMod where
+instance (Functor m, MonadIO m, MonadBaseControl IO m)
+      => HasDynFlags (GhcModT m) where
     getDynFlags = getSessionDynFlags
 #endif
 
-instance ExceptionMonad GhcMod where
+instance (MonadIO m, MonadBaseControl IO m)
+      => ExceptionMonad (GhcModT m) where
     gcatch act handler = control $ \run ->
         run act `gcatch` (run . handler)
 

Language/Haskell/GhcMod/PkgDoc.hs

@@ -1,30 +1,26 @@
-module Language.Haskell.GhcMod.PkgDoc (packageDoc) where
+module Language.Haskell.GhcMod.PkgDoc (pkgDoc) where
 
+import CoreMonad (liftIO)
 import Language.Haskell.GhcMod.Types
 import Language.Haskell.GhcMod.GhcPkg
+import Language.Haskell.GhcMod.Monad
 
 import Control.Applicative ((<$>))
 import System.Process (readProcess)
 
 -- | Obtaining the package name and the doc path of a module.
-packageDoc :: Options
+pkgDoc :: IOish m => String -> GhcModT m String
-           -> Cradle
+pkgDoc mdl = cradle >>= \c -> liftIO $ do
-           -> ModuleString
+    pkg <- trim <$> readProcess "ghc-pkg" (toModuleOpts c) []
-           -> IO String
-packageDoc _ cradle mdl = pkgDoc cradle mdl
-
-pkgDoc :: Cradle -> String -> IO String
-pkgDoc cradle mdl = do
-    pkg <- trim <$> readProcess "ghc-pkg" toModuleOpts []
     if pkg == "" then
         return "\n"
       else do
-        htmlpath <- readProcess "ghc-pkg" (toDocDirOpts pkg) []
+        htmlpath <- readProcess "ghc-pkg" (toDocDirOpts pkg c) []
         let ret = pkg ++ " " ++ drop 14 htmlpath
         return ret
   where
-    toModuleOpts = ["find-module", mdl, "--simple-output"]
+    toModuleOpts c = ["find-module", mdl, "--simple-output"]
-                   ++ ghcPkgDbStackOpts (cradlePkgDbStack cradle)
+                   ++ ghcPkgDbStackOpts (cradlePkgDbStack c)
-    toDocDirOpts pkg = ["field", pkg, "haddock-html"]
+    toDocDirOpts pkg c = ["field", pkg, "haddock-html"]
-                       ++ ghcPkgDbStackOpts (cradlePkgDbStack cradle)
+                       ++ ghcPkgDbStackOpts (cradlePkgDbStack c)
     trim = takeWhile (`notElem` " \n")

Language/Haskell/GhcMod/SrcUtils.hs

@@ -13,7 +13,7 @@ import GhcMonad
 import qualified GHC as G
 import GHC.SYB.Utils (Stage(..), everythingStaged)
 import Language.Haskell.GhcMod.Doc (showOneLine, getStyle)
-import Language.Haskell.GhcMod.GHCApi
+import Language.Haskell.GhcMod.DynFlags
 import Language.Haskell.GhcMod.Gap (HasType(..), setWarnTypedHoles, setDeferTypeErrors)
 import qualified Language.Haskell.GhcMod.Gap as Gap
 import Outputable (PprStyle)

Language/Haskell/GhcMod/Types.hs

@@ -1,6 +1,9 @@
 module Language.Haskell.GhcMod.Types where
 
 import Data.List (intercalate)
+import qualified Data.Map as M
+
+import PackageConfig (PackageConfig)
 
 -- | Output style.
 data OutputStyle = LispStyle  -- ^ S expression style.
@@ -87,12 +90,18 @@ showPkg (n,v,_) = intercalate "-" [n,v]
 showPkgId :: Package -> String
 showPkgId (n,v,i) = intercalate "-" [n,v,i]
 
+-- | Collection of packages
+type PkgDb = (M.Map Package PackageConfig)
+
 -- | Haskell expression.
 type Expression = String
 
 -- | Module name.
 type ModuleString = String
 
+-- | A Module
+type Module = [String]
+
 -- | Option information for GHC
 data CompilerOptions = CompilerOptions {
     ghcOptions  :: [GHCOption]  -- ^ Command line options

elisp/ghc-comp.el

@@ -168,7 +168,7 @@ unloaded modules are loaded")
 	    (ghc-reset-window-configuration)
 	  (ghc-save-window-configuration)
 	  (with-output-to-temp-buffer ghc-completion-buffer-name
-	    (display-completion-list list pattern))))))))
+	    (display-completion-list list))))))))
 
 (defun ghc-save-window-configuration ()
   (unless (get-buffer-window ghc-completion-buffer-name)

elisp/ghc.el

@@ -28,7 +28,7 @@
 	       (< emacs-minor-version minor)))
       (error "ghc-mod requires at least Emacs %d.%d" major minor)))
 
-(defconst ghc-version "4.1.0")
+(defconst ghc-version "5.0.0")
 
 ;; (eval-when-compile
 ;;  (require 'haskell-mode))
@@ -121,13 +121,14 @@
 (defun ghc-debug ()
   (interactive)
   (let ((el-path (locate-file "ghc.el" load-path))
-	(ghc-path (executable-find "ghc"))
+	(ghc-path (executable-find "ghc")) ;; FIXME
 	(ghc-mod-path (executable-find ghc-module-command))
 	(ghc-modi-path (executable-find ghc-interactive-command))
 	(el-ver ghc-version)
 	(ghc-ver (ghc-run-ghc-mod '("--version") "ghc"))
 	(ghc-mod-ver (ghc-run-ghc-mod '("version")))
-	(ghc-modi-ver (ghc-run-ghc-mod '("version") ghc-interactive-command)))
+	(ghc-modi-ver (ghc-run-ghc-mod '("version") ghc-interactive-command))
+	(path (getenv "PATH")))
     (switch-to-buffer (get-buffer-create "**GHC Debug**"))
     (erase-buffer)
     (insert "Path: check if you are using intended programs.\n")
@@ -139,6 +140,8 @@
     (insert (format "\t  ghc.el version %s\n" el-ver))
     (insert (format "\t %s\n" ghc-mod-ver))
     (insert (format "\t%s\n" ghc-modi-ver))
-    (insert (format "\t%s\n" ghc-ver))))
+    (insert (format "\t%s\n" ghc-ver))
+    (insert "\nEnvironment variables:\n")
+    (insert (format "\tPATH=%s\n" path))))
 
 (provide 'ghc)

ghc-mod.cabal

@@ -1,5 +1,5 @@
 Name:                   ghc-mod
-Version:                4.1.0
+Version:                5.0.0
 Author:                 Kazu Yamamoto <kazu@iij.ad.jp>
 Maintainer:             Kazu Yamamoto <kazu@iij.ad.jp>
 License:                BSD3
@@ -51,6 +51,7 @@ Extra-Source-Files:     ChangeLog
 Library
   Default-Language:     Haskell2010
   GHC-Options:          -Wall
+  Default-Extensions:   ConstraintKinds, FlexibleContexts
   Exposed-Modules:      Language.Haskell.GhcMod
                         Language.Haskell.GhcMod.Ghc
                         Language.Haskell.GhcMod.Monad
@@ -67,6 +68,7 @@ Library
                         Language.Haskell.GhcMod.Convert
                         Language.Haskell.GhcMod.Debug
                         Language.Haskell.GhcMod.Doc
+                        Language.Haskell.GhcMod.DynFlags
                         Language.Haskell.GhcMod.FillSig
                         Language.Haskell.GhcMod.Find
                         Language.Haskell.GhcMod.Flag
@@ -100,7 +102,7 @@ Library
                       , time
                       , transformers
                       , transformers-base
-                      , mtl
+                      , mtl >= 2.0
                       , monad-control
                       , split
                       , haskell-src-exts
@@ -116,10 +118,12 @@ Executable ghc-mod
   Main-Is:              GHCMod.hs
   Other-Modules:        Paths_ghc_mod
   GHC-Options:          -Wall
+  Default-Extensions:   ConstraintKinds, FlexibleContexts
   HS-Source-Dirs:       src
   Build-Depends:        base >= 4.0 && < 5
                       , directory
                       , filepath
+                      , mtl >= 2.0
                       , ghc
                       , ghc-mod
 
@@ -128,6 +132,7 @@ Executable ghc-modi
   Main-Is:              GHCModi.hs
   Other-Modules:        Paths_ghc_mod
   GHC-Options:          -Wall
+  Default-Extensions:   ConstraintKinds, FlexibleContexts
   HS-Source-Dirs:       src
   Build-Depends:        base >= 4.0 && < 5
                       , containers
@@ -140,13 +145,15 @@ Test-Suite doctest
   Type:                 exitcode-stdio-1.0
   Default-Language:     Haskell2010
   HS-Source-Dirs:       test
-  Ghc-Options:          -threaded -Wall
+  Ghc-Options:          -Wall
+  Default-Extensions:   ConstraintKinds, FlexibleContexts
   Main-Is:              doctests.hs
   Build-Depends:        base
                       , doctest >= 0.9.3
 
 Test-Suite spec
   Default-Language:     Haskell2010
+  Default-Extensions:   ConstraintKinds, FlexibleContexts
   Main-Is:              Main.hs
   Hs-Source-Dirs:       test, .
   Type:                 exitcode-stdio-1.0
@@ -178,7 +185,7 @@ Test-Suite spec
                       , time
                       , transformers
                       , transformers-base
-                      , mtl
+                      , mtl >= 2.0
                       , monad-control
                       , hspec >= 1.8.2
                       , split

src/GHCMod.hs

@@ -5,6 +5,7 @@ module Main where
 import Config (cProjectVersion)
 import Control.Applicative ((<$>))
 import Control.Exception (Exception, Handler(..), ErrorCall(..))
+import CoreMonad (liftIO)
 import qualified Control.Exception as E
 import Data.Typeable (Typeable)
 import Data.Version (showVersion)
@@ -103,7 +104,6 @@ main = flip E.catches handlers $ do
 -- #endif
     args <- getArgs
     let (opt,cmdArg) = parseArgs argspec args
-    cradle <- findCradle
     let cmdArg0 = cmdArg !. 0
         cmdArg1 = cmdArg !. 1
         cmdArg3 = cmdArg !. 3
@@ -113,24 +113,24 @@ main = flip E.catches handlers $ do
         nArgs n f = if length remainingArgs == n
                         then f
                         else E.throw (ArgumentsMismatch cmdArg0)
-    res <- case cmdArg0 of
+    res <- runGhcModT opt $ case cmdArg0 of
-      "list"    -> listModules opt cradle
+      "list"    -> modules
-      "lang"    -> listLanguages opt
+      "lang"    -> languages
-      "flag"    -> listFlags opt
+      "flag"    -> flags
-      "browse"  -> runGhcMod opt $ concat <$> mapM browse remainingArgs
+      "browse"  -> concat <$> mapM browse remainingArgs
-      "check"   -> runGhcMod opt $ checkSyntax remainingArgs
+      "check"   -> checkSyntax remainingArgs
-      "expand"  -> runGhcMod opt $ expandTemplate remainingArgs
+      "expand"  -> expandTemplate remainingArgs
-      "debug"   -> debugInfo opt cradle
+      "debug"   -> debugInfo
-      "info"    -> nArgs 3 infoExpr opt cradle cmdArg1 cmdArg3
+      "info"    -> nArgs 3 info cmdArg1 cmdArg3
-      "type"    -> nArgs 4 $ typeExpr opt cradle cmdArg1 (read cmdArg3) (read cmdArg4)
+      "type"    -> nArgs 4 $ types cmdArg1 (read cmdArg3) (read cmdArg4)
-      "split"   -> nArgs 4 $ splitVar opt cradle cmdArg1 (read cmdArg3) (read cmdArg4)
+      "split"   -> nArgs 4 $ splits cmdArg1 (read cmdArg3) (read cmdArg4)
-      "sig"     -> nArgs 4 $ fillSig opt cradle cmdArg1 (read cmdArg3) (read cmdArg4)
+      "sig"     -> nArgs 4 $ sig cmdArg1 (read cmdArg3) (read cmdArg4)
-      "refine"  -> nArgs 5 $ refineVar opt cradle cmdArg1 (read cmdArg3) (read cmdArg4) cmdArg5
+      --"refine"  -> nArgs 5 $ refine cmdArg1 (read cmdArg3) (read cmdArg4) cmdArg5
-      "find"    -> runGhcMod opt $ nArgs 1 $ findSymbol cmdArg1
+      "find"    -> nArgs 1 $ findSymbol cmdArg1
-      "lint"    -> nArgs 1 withFile (lintSyntax opt) cmdArg1
+      "lint"    -> nArgs 1 $ withFile lint cmdArg1
-      "root"    -> rootInfo opt cradle
+      "root"    -> rootInfo
-      "doc"     -> nArgs 1 $ packageDoc opt cradle cmdArg1
+      "doc"     -> nArgs 1 $ pkgDoc cmdArg1
-      "boot"    -> bootInfo opt
+      "boot"    -> boot
       "version" -> return progVersion
       "help"    -> return $ O.usageInfo usage argspec
       cmd       -> E.throw (NoSuchCommand cmd)
@@ -155,8 +155,9 @@ main = flip E.catches handlers $ do
         hPutStrLn stderr $ "\"" ++ file ++ "\" not found"
         printUsage
     printUsage = hPutStrLn stderr $ '\n' : O.usageInfo usage argspec
+    withFile :: IOish m => (FilePath -> GhcModT m a) -> FilePath -> GhcModT m a
     withFile cmd file = do
-        exist <- doesFileExist file
+        exist <- liftIO $ doesFileExist file
         if exist
             then cmd file
             else E.throw (FileNotExist file)

src/GHCModi.hs

@@ -31,12 +31,12 @@ import Data.Set (Set)
 import qualified Data.Set as S
 import Data.Typeable (Typeable)
 import Data.Version (showVersion)
+import Exception (ghandle)
 import GHC (GhcMonad)
 import qualified GHC as G
 import Language.Haskell.GhcMod
 import Language.Haskell.GhcMod.Ghc
 import Language.Haskell.GhcMod.Monad
-import Language.Haskell.GhcMod.Internal
 import Paths_ghc_mod
 import System.Console.GetOpt
 import System.Directory (setCurrentDirectory)
@@ -98,12 +98,11 @@ main = E.handle cmdHandler $
     go (opt,_) = E.handle someHandler $ do
         cradle0 <- findCradle
         let rootdir = cradleRootDir cradle0
-            cradle = cradle0 { cradleCurrentDir = rootdir }
+--            c = cradle0 { cradleCurrentDir = rootdir } TODO: ?????
         setCurrentDirectory rootdir
         mvar <- liftIO newEmptyMVar
-        mlibdir <- getSystemLibDir
+        void $ forkIO $ runGhcModT opt $ setupDB mvar
-        void $ forkIO $ setupDB cradle mlibdir opt mvar
+        runGhcModT opt $ loop S.empty mvar
-        run cradle mlibdir opt $ loop opt S.empty mvar
       where
         -- this is just in case.
         -- If an error is caught here, it is a bug of GhcMod library.
@@ -117,36 +116,28 @@ replace (x:xs)    =  x  : replace xs
 
 ----------------------------------------------------------------
 
-run :: Cradle -> Maybe FilePath -> Options -> GhcMod a -> IO a
+setupDB :: IOish m => MVar SymMdlDb -> GhcModT m ()
-run _ _ opt body = runGhcMod opt $ do
+setupDB mvar = ghandle handler $ do
-    dflags <- G.getSessionDynFlags
+    liftIO . putMVar mvar =<< getSymMdlDb
-    G.defaultCleanupHandler dflags body
-
-----------------------------------------------------------------
-
-setupDB :: Cradle -> Maybe FilePath -> Options -> MVar SymMdlDb -> IO ()
-setupDB cradle mlibdir opt mvar = E.handle handler $ do
-    db <- run cradle mlibdir opt getSymMdlDb
-    putMVar mvar db
   where
     handler (SomeException _) = return () -- fixme: put emptyDb?
 
 ----------------------------------------------------------------
 
-loop :: Options -> Set FilePath -> MVar SymMdlDb -> GhcMod ()
+loop :: IOish m => Set FilePath -> MVar SymMdlDb -> GhcModT m ()
-loop opt set mvar = do
+loop set mvar = do
     cmdArg <- liftIO getLine
     let (cmd,arg') = break (== ' ') cmdArg
         arg = dropWhile (== ' ') arg'
     (ret,ok,set') <- case cmd of
-        "check"  -> checkStx opt set arg
+        "check"  -> checkStx set arg
         "find"   -> findSym set arg mvar
-        "lint"   -> toGhcMod $ lintStx  opt set arg
+        "lint"   -> lintStx set arg
         "info"   -> showInfo set arg
         "type"   -> showType set arg
         "split"  -> doSplit set arg
         "sig"    -> doSig set arg
-        "refine" -> doRefine set arg
+        -- "refine" -> doRefine set arg
         "boot"   -> bootIt set
         "browse" -> browseIt set arg
         "quit"   -> return ("quit", False, set)
@@ -158,15 +149,15 @@ loop opt set mvar = do
       else do
         liftIO $ putStrLn $ "NG " ++ replace ret
     liftIO $ hFlush stdout
-    when ok $ loop opt set' mvar
+    when ok $ loop set' mvar
 
 ----------------------------------------------------------------
 
-checkStx :: Options
+checkStx :: IOish m
-         -> Set FilePath
+         => Set FilePath
          -> FilePath
-         -> GhcMod (String, Bool, Set FilePath)
+         -> GhcModT m (String, Bool, Set FilePath)
-checkStx _ set file = do
+checkStx set file = do
     set' <- toGhcMod $ newFileSet set file
     let files = S.toList set'
     eret <- check files
@@ -202,24 +193,25 @@ isSameMainFile file (Just x)
 
 ----------------------------------------------------------------
 
-findSym :: Set FilePath -> String -> MVar SymMdlDb
+findSym :: IOish m => Set FilePath -> String -> MVar SymMdlDb
-        -> GhcMod (String, Bool, Set FilePath)
+        -> GhcModT m (String, Bool, Set FilePath)
 findSym set sym mvar = do
     db <- liftIO $ readMVar mvar
     opt <- options
     let ret = lookupSym' opt sym db
     return (ret, True, set)
 
-lintStx :: GhcMonad m
+lintStx :: IOish m => Set FilePath
-        => Options -> Set FilePath -> FilePath
+        -> FilePath
-        -> m (String, Bool, Set FilePath)
+        -> GhcModT m (String, Bool, Set FilePath)
-lintStx opt set optFile = liftIO $ do
+lintStx set optFile = do
-    ret <-lintSyntax opt' file
+    ret <- local env' $ lint file
     return (ret, True, set)
   where
     (opts,file) = parseLintOptions optFile
     hopts = if opts == "" then [] else read opts
-    opt' = opt { hlintOpts = hopts }
+    env' e = e { gmOptions = opt' $ gmOptions e }
+    opt' o = o { hlintOpts = hopts }
 
 -- |
 -- >>> parseLintOptions "[\"--ignore=Use camelCase\", \"--ignore=Eta reduce\"] file name"
@@ -238,42 +230,47 @@ parseLintOptions optFile = case brk (== ']') (dropWhile (/= '[') optFile) of
 
 ----------------------------------------------------------------
 
-showInfo :: Set FilePath
+showInfo :: IOish m
+         => Set FilePath
          -> FilePath
-         -> GhcMod (String, Bool, Set FilePath)
+         -> GhcModT m (String, Bool, Set FilePath)
 showInfo set fileArg = do
     let [file, expr] = words fileArg
     set' <- newFileSet set file
     ret <- info file expr
     return (ret, True, set')
 
-showType :: Set FilePath
+showType :: IOish m
+         => Set FilePath
          -> FilePath
-         -> GhcMod (String, Bool, Set FilePath)
+         -> GhcModT m (String, Bool, Set FilePath)
 showType set fileArg  = do
     let [file, line, column] = words fileArg
     set' <- newFileSet set file
     ret <- types file (read line) (read column)
     return (ret, True, set')
 
-doSplit :: Set FilePath
+doSplit :: IOish m
+        => Set FilePath
         -> FilePath
-        -> GhcMod (String, Bool, Set FilePath)
+        -> GhcModT m (String, Bool, Set FilePath)
 doSplit set fileArg  = do
     let [file, line, column] = words fileArg
     set' <- newFileSet set file
     ret <- splits file (read line) (read column)
     return (ret, True, set')
 
-doSig :: Set FilePath
+doSig :: IOish m
+      => Set FilePath
       -> FilePath
-      -> GhcMod (String, Bool, Set FilePath)
+      -> GhcModT m (String, Bool, Set FilePath)
 doSig set fileArg  = do
     let [file, line, column] = words fileArg
     set' <- newFileSet set file
     ret <- sig file (read line) (read column)
     return (ret, True, set')
 
+{-
 doRefine :: Set FilePath
          -> FilePath
          -> GhcMod (String, Bool, Set FilePath)
@@ -282,18 +279,21 @@ doRefine set fileArg  = do
     set' <- newFileSet set file
     ret <- rewrite file (read line) (read column) expr
     return (ret, True, set')
+-}
 
 ----------------------------------------------------------------
 
-bootIt :: Set FilePath
+bootIt :: IOish m
-       -> GhcMod (String, Bool, Set FilePath)
+       => Set FilePath
+       -> GhcModT m (String, Bool, Set FilePath)
 bootIt set = do
     ret <- boot
     return (ret, True, set)
 
-browseIt :: Set FilePath
+browseIt :: IOish m
+         => Set FilePath
          -> ModuleString
-         -> GhcMod (String, Bool, Set FilePath)
+         -> GhcModT m (String, Bool, Set FilePath)
 browseIt set mdl = do
     ret <- browse mdl
     return (ret, True, set)

test/BrowseSpec.hs

@@ -10,25 +10,25 @@ import Dir
 
 spec :: Spec
 spec = do
-    describe "browse" $ do
+    describe "browse Data.Map" $ do
-        it "lists up symbols in the module" $ do
+        it "contains at least `differenceWithKey'" $ do
             syms <- runD $ lines <$> browse "Data.Map"
             syms `shouldContain` ["differenceWithKey"]
 
-    describe "browse -d" $ do
+    describe "browse -d Data.Either" $ do
-        it "lists up symbols with type info in the module" $ do
+        it "contains functions (e.g. `either') including their type signature" $ do
             syms <- run defaultOptions { detailed = True }
                     $ lines <$> browse "Data.Either"
             syms `shouldContain` ["either :: (a -> c) -> (b -> c) -> Either a b -> c"]
 
-        it "lists up data constructors with type info in the module" $ do
+        it "contains type constructors (e.g. `Left') including their type signature" $ do
             cradle <- findCradle
             syms <- run defaultOptions { detailed = True}
                     $ lines <$> browse "Data.Either"
             syms `shouldContain` ["Left :: a -> Either a b"]
 
-    describe "browse local" $ do
+    describe "`browse' in a project directory" $ do
-        it "lists symbols in a local module" $ do
+        it "lists symbols defined in a a local module (e.g. `Baz.baz)" $ do
             withDirectory_ "test/data" $ do
                 syms <- runID $ lines <$> browse "Baz"
                 syms `shouldContain` ["baz"]

test/CheckSpec.hs

@@ -12,28 +12,28 @@ import Dir
 spec :: Spec
 spec = do
     describe "checkSyntax" $ do
-        it "can check even if an executable depends on its library" $ do
+        it "works even if an executable depends on the library defined in the same cabal file" $ do
             withDirectory_ "test/data/ghc-mod-check" $ do
                 res <- runID $ checkSyntax ["main.hs"]
                 res `shouldBe` "main.hs:5:1:Warning: Top-level binding with no type signature: main :: IO ()\n"
 
-        it "can check even if a test module imports another test module located at different directory" $ do
+        it "works even if a module imports another module from a different directory" $ do
             withDirectory_ "test/data/check-test-subdir" $ do
                 res <- runID $ checkSyntax ["test/Bar/Baz.hs"]
                 res `shouldSatisfy` (("test" </> "Foo.hs:3:1:Warning: Top-level binding with no type signature: foo :: [Char]\n") `isSuffixOf`)
 
-        it "can detect mutually imported modules" $ do
+        it "detects cyclic imports" $ do
             withDirectory_ "test/data" $ do
                 res <- runID $ checkSyntax ["Mutual1.hs"]
                 res `shouldSatisfy` ("Module imports form a cycle" `isInfixOf`)
 
-        it "can check a module using QuasiQuotes" $ do
+        it "works with modules using QuasiQuotes" $ do
             withDirectory_ "test/data" $ do
                 res <- runID $ checkSyntax ["Baz.hs"]
                 res `shouldSatisfy` ("Baz.hs:5:1:Warning:" `isPrefixOf`)
 
-        context "without errors" $ do
+        context "when no errors are found" $ do
-            it "doesn't output empty line" $ do
+            it "doesn't output an empty line" $ do
                 withDirectory_ "test/data/ghc-mod-check/Data" $ do
                     res <- runID $ checkSyntax ["Foo.hs"]
                     res `shouldBe` ""

test/FlagSpec.hs

@@ -3,10 +3,11 @@ module FlagSpec where
 import Control.Applicative
 import Language.Haskell.GhcMod
 import Test.Hspec
+import TestUtils
 
 spec :: Spec
 spec = do
-    describe "listFlags" $ do
+    describe "flags" $ do
-        it "lists up GHC flags" $ do
+        it "contains at least `-fno-warn-orphans'" $ do
-            flags <- lines <$> listFlags defaultOptions
+            f <- runD $ lines <$> flags
-            flags `shouldContain` ["-fno-warn-orphans"]
+            f `shouldContain` ["-fno-warn-orphans"]

test/GhcApiSpec.hs

@@ -0,0 +1,31 @@
+module GhcApiSpec where
+
+import Control.Applicative
+import Control.Monad
+import Data.List (sort)
+import Language.Haskell.GhcMod.GHCApi
+import Test.Hspec
+import TestUtils
+import CoreMonad (liftIO)
+
+import Dir
+
+spec :: Spec
+spec = do
+    describe "findModule" $ do
+        it "finds Data.List in `base' and `haskell2010'"
+            $ withDirectory_ "test/data" $ runD $ do
+                pkgs <- findModule "Data.List" <$> ghcPkgDb
+                let pkgNames = pkgName `map` pkgs
+                liftIO $ pkgNames `shouldContain` ["base", "haskell2010"]
+
+    describe "moduleInfo" $ do
+        it "works for modules from global packages (e.g. base:Data.List)"
+            $ withDirectory_ "test/data" $ runD $ do
+                Just info <- moduleInfo (Just ("base","","")) "Data.List"
+                liftIO $ sort (bindings info) `shouldContain` ["++"]
+
+        it "works for local modules"
+            $ withDirectory_ "test/data" $ runD $ do
+                Just info <- moduleInfo Nothing "Baz"
+                liftIO $ bindings info `shouldContain` ["baz"]

test/GhcPkgSpec.hs

@@ -18,10 +18,10 @@ spec = do
             getPackageDbStack "test/data/" `shouldReturn` [GlobalDb, PackageDb $ cwd </> "test/data/.cabal-sandbox/i386-osx-ghc-7.6.3-packages.conf.d"]
 #endif
 
-        it "parses a config file and extracts sandbox package db" $ do
+        it "can parse a config file and extract the sandbox package-db" $ do
             cwd <- getCurrentDirectory
             pkgDb <- getSandboxDb "test/data/"
             pkgDb `shouldBe` (cwd </> "test/data/.cabal-sandbox/i386-osx-ghc-7.6.3-packages.conf.d")
 
-        it "throws an error if a config file is broken" $ do
+        it "throws an error if the sandbox config file is broken" $ do
             getSandboxDb "test/data/broken-sandbox" `shouldThrow` anyException

test/InfoSpec.hs

@@ -14,47 +14,47 @@ import System.Exit
 import System.FilePath
 import System.Process
 import Test.Hspec
-
+import TestUtils
 import Dir
 
 spec :: Spec
 spec = do
-    describe "typeExpr" $ do
+    describe "types" $ do
         it "shows types of the expression and its outers" $ do
             withDirectory_ "test/data/ghc-mod-check" $ do
                 cradle <- findCradleWithoutSandbox
-                res <- typeExpr defaultOptions cradle "Data/Foo.hs" 9 5
+                res <- runD $ types "Data/Foo.hs" 9 5
                 res `shouldBe` "9 5 11 40 \"Int -> a -> a -> a\"\n7 1 11 40 \"Int -> Integer\"\n"
 
         it "works with a module using TemplateHaskell" $ do
             withDirectory_ "test/data" $ do
                 cradle <- findCradleWithoutSandbox
-                res <- typeExpr defaultOptions cradle "Bar.hs" 5 1
+                res <- runD $ types "Bar.hs" 5 1
                 res `shouldBe` unlines ["5 1 5 20 \"[Char]\""]
 
         it "works with a module that imports another module using TemplateHaskell" $ do
             withDirectory_ "test/data" $ do
                 cradle <- findCradleWithoutSandbox
-                res <- typeExpr defaultOptions cradle "Main.hs" 3 8
+                res <- runD $ types "Main.hs" 3 8
                 res `shouldBe` unlines ["3 8 3 16 \"String -> IO ()\"", "3 8 3 20 \"IO ()\"", "3 1 3 20 \"IO ()\""]
 
-    describe "infoExpr" $ do
+    describe "info" $ do
         it "works for non-export functions" $ do
             withDirectory_ "test/data" $ do
                 cradle <- findCradleWithoutSandbox
-                res <- infoExpr defaultOptions cradle "Info.hs" "fib"
+                res <- runD $ info "Info.hs" "fib"
                 res `shouldSatisfy` ("fib :: Int -> Int" `isPrefixOf`)
 
         it "works with a module using TemplateHaskell" $ do
             withDirectory_ "test/data" $ do
                 cradle <- findCradleWithoutSandbox
-                res <- infoExpr defaultOptions cradle "Bar.hs" "foo"
+                res <- runD $ info "Bar.hs" "foo"
                 res `shouldSatisfy` ("foo :: ExpQ" `isPrefixOf`)
 
         it "works with a module that imports another module using TemplateHaskell" $ do
             withDirectory_ "test/data" $ do
                 cradle <- findCradleWithoutSandbox
-                res <- infoExpr defaultOptions cradle "Main.hs" "bar"
+                res <- runD $ info "Main.hs" "bar"
                 res `shouldSatisfy` ("bar :: [Char]" `isPrefixOf`)
 
         it "doesn't fail on unicode output" $ do

test/LangSpec.hs

@@ -3,10 +3,11 @@ module LangSpec where
 import Control.Applicative
 import Language.Haskell.GhcMod
 import Test.Hspec
+import TestUtils
 
 spec :: Spec
 spec = do
-    describe "listLanguages" $ do
+    describe "languages" $ do
-        it "lists up language extensions" $ do
+        it "contains at lest `OverloadedStrings'" $ do
-            exts <- lines <$> listLanguages defaultOptions
+            exts <- runD $ lines <$> languages
             exts `shouldContain` ["OverloadedStrings"]

test/LintSpec.hs

@@ -2,15 +2,16 @@ module LintSpec where
 
 import Language.Haskell.GhcMod
 import Test.Hspec
+import TestUtils
 
 spec :: Spec
 spec = do
-    describe "lintSyntax" $ do
+    describe "lint" $ do
-        it "check syntax with HLint" $ do
+        it "can detect a redundant import" $ do
-            res <- lintSyntax defaultOptions "test/data/hlint.hs"
+            res <- runD $ lint "test/data/hlint.hs"
             res `shouldBe` "test/data/hlint.hs:4:8: Error: Redundant do\NULFound:\NUL  do putStrLn \"Hello, world!\"\NULWhy not:\NUL  putStrLn \"Hello, world!\"\n"
 
-        context "without suggestions" $ do
+        context "when no suggestions are given" $ do
-            it "doesn't output empty line" $ do
+            it "doesn't output an empty line" $ do
-                res <- lintSyntax defaultOptions "test/data/ghc-mod-check/Data/Foo.hs"
+                res <- runD $ lint "test/data/ghc-mod-check/Data/Foo.hs"
                 res `shouldBe` ""

test/ListSpec.hs

@@ -3,11 +3,11 @@ module ListSpec where
 import Control.Applicative
 import Language.Haskell.GhcMod
 import Test.Hspec
+import TestUtils
 
 spec :: Spec
 spec = do
-    describe "listModules" $ do
+    describe "modules" $ do
-        it "lists up module names" $ do
+        it "contains at least `Data.Map'" $ do
-            cradle <- findCradle
+            modules <- runD $ lines <$> modules
-            modules <- lines <$> listModules defaultOptions cradle
             modules `shouldContain` ["Data.Map"]

test/Main.hs

@@ -7,6 +7,7 @@ import System.Process
 
 import Language.Haskell.GhcMod (debugInfo, defaultOptions, findCradle)
 import Control.Exception as E
+import TestUtils
 
 main = do
   let sandboxes = [ "test/data", "test/data/check-packageid"
@@ -25,7 +26,7 @@ main = do
   putStrLn $ "ghc-mod was built with Cabal version " ++ VERSION_Cabal
   system "ghc --version"
 
-  (putStrLn =<< debugInfo defaultOptions =<< findCradle)
+  (putStrLn =<< runD debugInfo)
       `E.catch` (\(_ :: E.SomeException) -> return () )
 
   hspec spec

test/TestUtils.hs

@@ -12,14 +12,14 @@ module TestUtils (
 import Language.Haskell.GhcMod.Monad
 import Language.Haskell.GhcMod.Types
 
-isolateCradle :: GhcMod a -> GhcMod a
+isolateCradle :: IOish m => GhcModT m a -> GhcModT m a
 isolateCradle action =
     local modifyEnv  $ action
  where
     modifyEnv e = e { gmCradle = (gmCradle e) { cradlePkgDbStack = [GlobalDb] } }
 
-runIsolatedGhcMod :: Options -> GhcMod a -> IO a
+runIsolatedGhcMod :: Options -> GhcModT IO a -> IO a
-runIsolatedGhcMod opt action = runGhcMod opt $ isolateCradle action
+runIsolatedGhcMod opt action = runGhcModT opt $ isolateCradle action
 
 -- | Run GhcMod in isolated cradle with default options
 runID = runIsolatedGhcMod defaultOptions
@@ -28,7 +28,9 @@ runID = runIsolatedGhcMod defaultOptions
 runI = runIsolatedGhcMod
 
 -- | Run GhcMod
-run = runGhcMod
+run :: Options -> GhcModT IO a -> IO a
+run = runGhcModT
 
 -- | Run GhcMod with default options
-runD = runGhcMod defaultOptions
+runD :: GhcModT IO a -> IO a
+runD = runGhcModT defaultOptions

test/data/Info.hs

@@ -1,3 +1,5 @@
+{-# LANGUAGE TemplateHaskell #-} -- for HscInterpreted
+
 module Info () where
 
 fib :: Int -> Int

test/data/Mutual1.hs

@@ -1,3 +1,5 @@
+{-# LANGUAGE TemplateHaskell #-} -- for HscInterpreted
+
 module Mutual1 where
 
 import Mutual2

test/doctests.hs

@@ -6,6 +6,7 @@ main :: IO ()
 main = doctest [
     "-package"
   , "ghc"
+  , "-XConstraintKinds", "-XFlexibleContexts"
   , "-idist/build/autogen/"
   , "-optP-include"
   , "-optPdist/build/autogen/cabal_macros.h"