Merge pull request #281 from DanielG/dev-monad

Migrate the remaining parts of the exposed API to `GhcMod a`

Language/Haskell/GhcMod.hs

@@ -12,23 +12,25 @@ module Language.Haskell.GhcMod (
   -- * Types
   , ModuleString
   , Expression
-  -- * 'IO' utilities
+  , GhcPkgDb
-  , bootInfo
+  -- * 'GhcMod' utilities
+  , boot
   , browse
+  , check
   , checkSyntax
-  , lintSyntax
-  , expandTemplate
-  , infoExpr
-  , typeExpr
-  , fillSig
-  , 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
-bootInfo opt = runGhcMod opt $ boot
 
 -- | Printing necessary information for front-end booting.
 boot :: GhcMod String
-boot = do
+boot =  concat <$> sequence [modules, languages, flags,
-    opt   <- options
+                             concat <$> mapM browse preBrowsedModules]
-    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/CaseSplit.hs

@@ -1,8 +1,7 @@
 {-# LANGUAGE CPP #-}
 
 module Language.Haskell.GhcMod.CaseSplit (
-    splitVar
+  splits
-  , splits
   ) where
 
 import Data.List (find, intercalate)
@@ -11,12 +10,10 @@ import qualified Data.Text.IO as T (readFile)
 import Exception (ghandle, SomeException(..))
 import GHC (GhcMonad, LHsBind, LHsExpr, LPat, Id, ParsedModule(..), TypecheckedModule(..), DynFlags, SrcSpan, Type, GenLocated(L))
 import qualified GHC as G
-import Language.Haskell.GhcMod.GHCApi
 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)
@@ -35,17 +32,6 @@ data SplitToTextInfo = SplitToTextInfo { sVarName     :: String
                                        , sTycons      :: [String]
                                        }
 
--- | Splitting a variable in a equation.
-splitVar :: Options
-         -> Cradle
-         -> 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.

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,44 @@
 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.GHCChoice ((||>))
 import Language.Haskell.GhcMod.Convert
+import Language.Haskell.GhcMod.Monad
 import Language.Haskell.GhcMod.Types
 
 ----------------------------------------------------------------
 
 -- | Obtaining debug information.
-debugInfo :: Options
+debugInfo :: GhcMod 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:    " ++ systemLibDir
       ]
   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 :: GhcMod String
-          -> Cradle
+rootInfo = convert' =<< cradleRootDir <$> cradle
-          -> IO String
-rootInfo opt cradle = return $ convert opt $ cradleRootDir cradle

Language/Haskell/GhcMod/FillSig.hs

@@ -1,8 +1,7 @@
 {-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies, FlexibleInstances, CPP #-}
 
 module Language.Haskell.GhcMod.FillSig (
-    fillSig
+    sig
-  , sig
   ) where
 
 import Data.Char (isSymbol)
@@ -10,12 +9,10 @@ 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 Outputable (PprStyle)
 import qualified Type as Ty
@@ -40,17 +37,6 @@ data SigInfo = Signature SrcSpan [G.RdrName] (G.HsType G.RdrName)
 -- Signature for fallback operation via haskell-src-exts
 data HESigInfo = HESignature HE.SrcSpan [HE.Name HE.SrcSpanInfo] (HE.Type HE.SrcSpanInfo)
 
--- | Create a initial body from a signature.
-fillSig :: Options
-        -> Cradle
-        -> 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.

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 :: GhcMod String
-listFlags opt = return $ convert opt [ "-f" ++ prefix ++ option
+flags = convert' [ "-f" ++ prefix ++ option
                  | option <- Gap.fOptions
                  , prefix <- ["","no-"]
                  ]

Language/Haskell/GhcMod/GHCApi.hs

@@ -6,7 +6,7 @@ module Language.Haskell.GhcMod.GHCApi (
   , initializeFlagsWithCradle
   , setTargetFiles
   , getDynamicFlags
-  , getSystemLibDir
+  , systemLibDir
   , withDynFlags
   , withCmdFlags
   , setNoWaringFlags
@@ -16,6 +16,8 @@ module Language.Haskell.GhcMod.GHCApi (
 import Language.Haskell.GhcMod.CabalApi
 import Language.Haskell.GhcMod.GHCChoice
 import Language.Haskell.GhcMod.GhcPkg
+import qualified Language.Haskell.GhcMod.Gap as Gap
+import Language.Haskell.GhcMod.Types
 
 import Control.Applicative ((<$>))
 import Control.Monad (forM, void)
@@ -25,8 +27,6 @@ import GHC (DynFlags(..), GhcLink(..), HscTarget(..), LoadHowMuch(..))
 import qualified GHC as G
 import GhcMonad
 import GHC.Paths (libdir)
-import qualified Language.Haskell.GhcMod.Gap as Gap
-import Language.Haskell.GhcMod.Types
 import System.Exit (exitSuccess)
 import System.IO (hPutStr, hPrint, stderr)
 import System.IO.Unsafe (unsafePerformIO)
@@ -34,8 +34,8 @@ import System.IO.Unsafe (unsafePerformIO)
 ----------------------------------------------------------------
 
 -- | Obtaining the directory for system libraries.
-getSystemLibDir :: IO (Maybe FilePath)
+systemLibDir :: FilePath
-getSystemLibDir = return $ Just libdir
+systemLibDir = libdir
 
 ----------------------------------------------------------------
 
@@ -53,8 +53,7 @@ withGHC file body = ghandle ignore $ withGHC' body
 
 withGHC' :: Ghc a -> IO a
 withGHC' body = do
-    mlibdir <- getSystemLibDir
+    G.runGhc (Just systemLibDir) $ do
-    G.runGhc mlibdir $ do
         dflags <- G.getSessionDynFlags
         G.defaultCleanupHandler dflags body
 
@@ -161,8 +160,7 @@ setTargetFiles files = do
 -- | Return the 'DynFlags' currently in use in the GHC session.
 getDynamicFlags :: IO DynFlags
 getDynamicFlags = do
-    mlibdir <- getSystemLibDir
+    G.runGhc (Just systemLibDir) G.getSessionDynFlags
-    G.runGhc mlibdir G.getSessionDynFlags
 
 withDynFlags :: GhcMonad m
              => (DynFlags -> DynFlags)
@@ -197,8 +195,7 @@ setAllWaringFlags df = df { warningFlags = allWarningFlags }
 
 allWarningFlags :: Gap.WarnFlags
 allWarningFlags = unsafePerformIO $ do
-    mlibdir <- getSystemLibDir
+    G.runGhc (Just systemLibDir) $ do
-    G.runGhc mlibdir $ do
         df <- G.getSessionDynFlags
         df' <- addCmdOpts ["-Wall"] df
         return $ G.warningFlags df'

Language/Haskell/GhcMod/Ghc.hs

@@ -2,15 +2,6 @@ module Language.Haskell.GhcMod.Ghc (
   -- * Converting the 'Ghc' monad to the 'IO' monad
     withGHC
   , withGHC'
-  -- * 'Ghc' utilities
-  , boot
-  , browse
-  , check
-  , info
-  , types
-  , splits
-  , sig
-  , modules
   -- * 'SymMdlDb'
   , Symbol
   , SymMdlDb
@@ -19,12 +10,5 @@ module Language.Haskell.GhcMod.Ghc (
   , 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
@@ -23,16 +20,6 @@ import Language.Haskell.GhcMod.Convert
 
 ----------------------------------------------------------------
 
--- | Obtaining information of a target expression. (GHCi's info:)
-infoExpr :: Options
-         -> Cradle
-         -> 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.
@@ -48,17 +35,6 @@ info file expr = do
 
 ----------------------------------------------------------------
 
--- | Obtaining type of a target expression. (GHCi's type:)
-typeExpr :: Options
-         -> Cradle
-         -> 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.
@@ -85,4 +61,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,8 +16,9 @@ module Language.Haskell.GhcMod.Internal (
   , cabalDependPackages
   , cabalSourceDirs
   , cabalAllTargets
+  -- * GHC.Paths
+  , systemLibDir
   -- * IO
-  , getSystemLibDir
   , getDynamicFlags
   -- * Initializing 'DynFlags'
   , initializeFlagsWithCradle

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 :: GhcMod 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 Control.Monad.Trans (liftIO)
 import Language.Haskell.GhcMod.Logger (checkErrorPrefix)
 import Language.Haskell.GhcMod.Convert
+import Language.Haskell.GhcMod.Monad
 import Language.Haskell.GhcMod.Types
 import Language.Haskell.HLint (hlint)
 
 -- | Checking syntax of a target file using hlint.
 --   Warnings and errors are returned.
-lintSyntax :: Options
+lint :: FilePath  -- ^ A target file.
-           -> FilePath  -- ^ A target file.
+     -> GhcMod String
-           -> IO String
+lint file = do
-lintSyntax opt file = handle handler $ pack <$> hlint (file : "--quiet" : hopts)
+  opt <- options
+  ghandle handler . pack =<< (liftIO $ hlint $ file : "--quiet" : hlintOpts opt)
  where
-    pack = convert opt . map (init . show) -- init drops the last \n.
+    pack = convert' . map (init . show) -- init drops the last \n.
-    hopts = hlintOpts opt
     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(..))
@@ -12,10 +12,6 @@ import UniqFM (eltsUFM)
 
 ----------------------------------------------------------------
 
--- | Listing installed modules.
-listModules :: Options -> Cradle -> IO String
-listModules opt _ = runGhcMod opt $ modules
-
 -- | Listing installed modules.
 modules :: GhcMod String
 modules = do

Language/Haskell/GhcMod/Monad.hs

@@ -9,9 +9,11 @@ module Language.Haskell.GhcMod.Monad (
  , GhcModState(..)
  , runGhcMod'
  , runGhcMod
+ , newGhcModEnv
  , withErrorHandler
  , toGhcMod
  , options
+ , cradle
  , module Control.Monad.Reader.Class
  , module Control.Monad.Writer.Class
  , module Control.Monad.State.Class
@@ -53,6 +55,7 @@ import Control.Monad.Writer.Class
 import Data.IORef (IORef, readIORef, writeIORef, newIORef)
 import System.Exit (exitSuccess)
 import System.IO (hPutStr, hPrint, stderr)
+import System.Directory (getCurrentDirectory)
 
 ----------------------------------------------------------------
 
@@ -98,18 +101,23 @@ runGhcMod' r s a = do
   (a', s',w) <- runRWST (unGhcMod $ initGhcMonad (Just libdir) >> a) r s
   return (a',(s',w))
 
+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
+        }
 
 runGhcMod :: Options -> GhcMod a -> IO a
 runGhcMod opt action = do
-    session <- newIORef (error "empty session")
+    env <- liftIO $ newGhcModEnv opt =<< getCurrentDirectory
-    cradle <- findCradle
-    let env = GhcModEnv { gmGhcSession = session
-                        , gmOptions = opt
-                        , gmCradle = cradle }
     (a,(_,_)) <- runGhcMod' env defaultState $ do
         dflags <- getSessionDynFlags
         defaultCleanupHandler dflags $ do
-            toGhcMod $ initializeFlagsWithCradle opt cradle
+            toGhcMod $ initializeFlagsWithCradle opt (gmCradle env)
             action
     return a
 
@@ -135,6 +143,9 @@ toGhcMod a = do
 options :: GhcMod Options
 options = gmOptions <$> ask
 
+cradle :: GhcMod Cradle
+cradle = gmCradle <$> ask
+
 instance MonadBase IO GhcMod where
     liftBase = GhcMod . liftBase
 

Language/Haskell/GhcMod/PkgDoc.hs

@@ -1,30 +1,26 @@
-module Language.Haskell.GhcMod.PkgDoc (packageDoc) where
+module Language.Haskell.GhcMod.PkgDoc (pkgDoc) where
 
+import Control.Monad.Trans (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 :: String -> GhcMod 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")

ghc-mod.cabal

@@ -120,6 +120,7 @@ Executable ghc-mod
   Build-Depends:        base >= 4.0 && < 5
                       , directory
                       , filepath
+                      , mtl >= 2.0
                       , ghc
                       , ghc-mod
 

src/GHCMod.hs

@@ -5,6 +5,7 @@ module Main where
 import Config (cProjectVersion)
 import Control.Applicative ((<$>))
 import Control.Exception (Exception, Handler(..), ErrorCall(..))
+import Control.Monad.Trans (liftIO)
 import qualified Control.Exception as E
 import Data.Typeable (Typeable)
 import Data.Version (showVersion)
@@ -102,7 +103,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
@@ -111,23 +111,23 @@ 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 <- runGhcMod 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)
-      "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)
@@ -152,8 +152,9 @@ main = flip E.catches handlers $ do
         hPutStrLn stderr $ "\"" ++ file ++ "\" not found"
         printUsage
     printUsage = hPutStrLn stderr $ '\n' : O.usageInfo usage argspec
+    withFile :: (FilePath -> GhcMod a) -> FilePath -> GhcMod 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 $ runGhcMod opt $ setupDB mvar
-        void $ forkIO $ setupDB cradle mlibdir opt mvar
+        runGhcMod 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,31 +116,23 @@ replace (x:xs)    =  x  : replace xs
 
 ----------------------------------------------------------------
 
-run :: Cradle -> Maybe FilePath -> Options -> GhcMod a -> IO a
+setupDB :: MVar SymMdlDb -> GhcMod ()
-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 :: Set FilePath -> MVar SymMdlDb -> GhcMod ()
-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
@@ -157,15 +148,14 @@ 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 :: Set FilePath
-         -> Set FilePath
          -> FilePath
          -> GhcMod (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
@@ -209,16 +199,17 @@ findSym set sym mvar = do
     let ret = lookupSym' opt sym db
     return (ret, True, set)
 
-lintStx :: GhcMonad m
+lintStx :: Set FilePath
-        => Options -> Set FilePath -> FilePath
+        -> FilePath
-        -> m (String, Bool, Set FilePath)
+        -> GhcMod (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"

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