Move `initializeFlagsWithCradle` to Monad.hs

Language/Haskell/GhcMod/Browse.hs

@@ -13,7 +13,7 @@ import FastString (mkFastString)
 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

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

Language/Haskell/GhcMod/Debug.hs

@@ -4,12 +4,10 @@ import Control.Applicative ((<$>))
 import CoreMonad (liftIO)
 import Data.List (intercalate)
 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
+import Language.Haskell.GhcMod.Internal
 
 ----------------------------------------------------------------
 
@@ -28,7 +26,7 @@ debugInfo = cradle >>= \c -> convert' =<< do
       , "GHC options:         " ++ unwords gopts
       , "Include directories: " ++ unwords incDir
       , "Dependent packages:  " ++ intercalate ", " (map showPkg pkgs)
-      , "System libraries:    " ++ systemLibDir
+      , "System libraries:    " ++ ghcLibDir
       ]
   where
     simpleCompilerOption = options >>= \op ->

Language/Haskell/GhcMod/GHCApi.hs

@@ -1,15 +1,7 @@
 {-# LANGUAGE ScopedTypeVariables, RecordWildCards #-}
 
 module Language.Haskell.GhcMod.GHCApi (
-    initializeFlagsWithCradle
-  , setTargetFiles
-  , getDynamicFlags
-  , systemLibDir
-  , withDynFlags
-  , withCmdFlags
-  , setNoWaringFlags
-  , setAllWaringFlags
-  , ghcPkgDb
+    ghcPkgDb
   , package
   , modules
   , findModule
@@ -18,80 +10,20 @@ module Language.Haskell.GhcMod.GHCApi (
   , bindings
   ) where
 
-import Language.Haskell.GhcMod.CabalApi
-import Language.Haskell.GhcMod.GHCChoice
 import Language.Haskell.GhcMod.GhcPkg
 import Language.Haskell.GhcMod.DynFlags
-import qualified Language.Haskell.GhcMod.Gap as Gap
 import Language.Haskell.GhcMod.Types
 
 import Control.Applicative ((<$>))
-import Control.Monad (void)
 import Distribution.Package (InstalledPackageId(..))
-import Data.Maybe (isJust, fromJust)
 import qualified Data.Map as M
 import GHC (DynFlags(..))
 import qualified GHC as G
 import GhcMonad
-import GHC.Paths (libdir)
 import qualified Packages as G
 import qualified Module as G
 import qualified OccName as G
 
-----------------------------------------------------------------
-
--- | Obtaining the directory for system libraries.
-systemLibDir :: FilePath
-systemLibDir = libdir
-
-----------------------------------------------------------------
-
-importDirs :: [IncludeDir]
-importDirs = [".","..","../..","../../..","../../../..","../../../../.."]
-
--- | 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)
-
 ----------------------------------------------------------------
 -- get Packages,Modules,Bindings
 
@@ -153,14 +85,3 @@ localModuleInfo mdl = moduleInfo Nothing mdl
 bindings :: G.ModuleInfo -> [Binding]
 bindings minfo = do
   map (G.occNameString . G.getOccName) $ G.modInfoExports minfo
-
-
-----------------------------------------------------------------
--- for PkgDoc
-
--- import Distribution.InstalledPackageInfo (showInstalledPackageInfoField)
--- haddockHtml :: GhcMonad m => Package -> m String
--- haddockHtml pkg = do
---     extractField info . fromJust . lookup pkg <$> ghcPkgDb
---  where
---     extractField = fromJust $ showInstalledPackageInfoField "haddock-html"

Language/Haskell/GhcMod/Ghc.hs

@@ -8,4 +8,3 @@ module Language.Haskell.GhcMod.Ghc (
   ) where
 
 import Language.Haskell.GhcMod.Find
-import Language.Haskell.GhcMod.GHCApi

Language/Haskell/GhcMod/Internal.hs

@@ -17,11 +17,9 @@ module Language.Haskell.GhcMod.Internal (
   , cabalSourceDirs
   , cabalAllTargets
   -- * GHC.Paths
-  , systemLibDir
+  , ghcLibDir
   -- * IO
   , getDynamicFlags
-  -- * Initializing 'DynFlags'
-  , initializeFlagsWithCradle
   -- * Targets
   , setTargetFiles
   -- * Logging
@@ -36,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/Logger.hs

@@ -17,7 +17,7 @@ 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

Language/Haskell/GhcMod/Monad.hs

@@ -1,6 +1,6 @@
 {-# LANGUAGE CPP, GeneralizedNewtypeDeriving, FlexibleInstances #-}
 {-# LANGUAGE FlexibleContexts, MultiParamTypeClasses, RankNTypes #-}
-{-# LANGUAGE TypeFamilies, UndecidableInstances #-}
+{-# LANGUAGE TypeFamilies, UndecidableInstances, RecordWildCards #-}
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 
 module Language.Haskell.GhcMod.Monad (
@@ -23,13 +23,18 @@ module Language.Haskell.GhcMod.Monad (
  , module Control.Monad.State.Class
  ) where
 
-import Language.Haskell.GhcMod.Cradle
-import Language.Haskell.GhcMod.GHCApi
 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
@@ -49,7 +54,7 @@ import Data.Monoid (Monoid)
 #endif
 
 import Control.Applicative (Alternative)
-import Control.Monad (MonadPlus, liftM)
+import Control.Monad (MonadPlus, liftM, void)
 import Control.Monad.Base (MonadBase, liftBase)
 
 import Control.Monad.Reader.Class
@@ -59,6 +64,7 @@ import Control.Monad.Trans.Control (MonadBaseControl(..), StM, liftBaseWith, con
 import Control.Monad.Trans.RWS.Lazy (RWST(..), runRWST)
 import Control.Monad.Writer.Class
 
+import Data.Maybe (fromJust, isJust)
 import Data.IORef (IORef, readIORef, writeIORef, newIORef)
 import System.Exit (exitSuccess)
 import System.IO (hPutStr, hPrint, stderr)
@@ -80,6 +86,7 @@ defaultState = GhcModState
 type GhcModWriter = ()
 
 ----------------------------------------------------------------
+
 type GhcMod a = GhcModT IO a
 
 newtype GhcModT m a = GhcModT {
@@ -103,6 +110,51 @@ instance (Monoid w, MonadIO m) => MonadIO (RWST r w s m) where
 #endif
 
 ----------------------------------------------------------------
+
+-- | 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 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
+            => 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)
+
+----------------------------------------------------------------
+
 runGhcModT' :: (MonadIO m, MonadBaseControl IO m)
            => GhcModEnv
            -> GhcModState

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)