From 9f94bc863c167628761bc926e6b9a9c69c5cc09e Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Daniel=20Gr=C3=B6ber?= <dxld@darkboxed.org>
Date: Fri, 11 Jul 2014 05:44:31 +0200
Subject: [PATCH 1/5] Add `Module` type

---
 Language/Haskell/GhcMod/Browse.hs | 4 ++--
 Language/Haskell/GhcMod/Types.hs  | 3 +++
 2 files changed, 5 insertions(+), 2 deletions(-)

diff --git a/Language/Haskell/GhcMod/Browse.hs b/Language/Haskell/GhcMod/Browse.hs
index 49798db..a984235 100644
--- a/Language/Haskell/GhcMod/Browse.hs
+++ b/Language/Haskell/GhcMod/Browse.hs
@@ -10,7 +10,7 @@ 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
@@ -144,7 +144,7 @@ browseAll dflag = do
     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
diff --git a/Language/Haskell/GhcMod/Types.hs b/Language/Haskell/GhcMod/Types.hs
index b8bb908..4dfb161 100644
--- a/Language/Haskell/GhcMod/Types.hs
+++ b/Language/Haskell/GhcMod/Types.hs
@@ -93,6 +93,9 @@ 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

From 73bf4cbc4eccca2583af99a7a5a4326265366c40 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Daniel=20Gr=C3=B6ber?= <dxld@darkboxed.org>
Date: Fri, 11 Jul 2014 10:40:09 +0200
Subject: [PATCH 2/5] Remove `withGhc` and `withGhc'`, they're not used
 anymore.

---
 Language/Haskell/GhcMod/GHCApi.hs | 25 ++-----------------------
 Language/Haskell/GhcMod/Ghc.hs    |  5 +----
 2 files changed, 3 insertions(+), 27 deletions(-)

diff --git a/Language/Haskell/GhcMod/GHCApi.hs b/Language/Haskell/GhcMod/GHCApi.hs
index 2cd0886..ba98bfe 100644
--- a/Language/Haskell/GhcMod/GHCApi.hs
+++ b/Language/Haskell/GhcMod/GHCApi.hs
@@ -1,9 +1,7 @@
 {-# LANGUAGE ScopedTypeVariables, RecordWildCards #-}
 
 module Language.Haskell.GhcMod.GHCApi (
-    withGHC
-  , withGHC'
-  , initializeFlagsWithCradle
+    initializeFlagsWithCradle
   , setTargetFiles
   , getDynamicFlags
   , systemLibDir
@@ -39,26 +37,6 @@ systemLibDir = libdir
 
 ----------------------------------------------------------------
 
--- | Converting the 'Ghc' monad to the 'IO' monad.
-withGHC :: FilePath  -- ^ A target file displayed in an error message.
-        -> 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
-withGHC' body = do
-    G.runGhc (Just systemLibDir) $ do
-        dflags <- G.getSessionDynFlags
-        G.defaultCleanupHandler dflags body
-
-----------------------------------------------------------------
-
 importDirs :: [IncludeDir]
 importDirs = [".","..","../..","../../..","../../../..","../../../../.."]
 
@@ -107,6 +85,7 @@ initSession build Options {..} CompilerOptions {..} = do
       $ setEmptyLogger
       $ Gap.addPackageFlags depPackages df)
 
+
 setEmptyLogger :: DynFlags -> DynFlags
 setEmptyLogger df = Gap.setLogAction df $ \_ _ _ _ _ -> return ()
 
diff --git a/Language/Haskell/GhcMod/Ghc.hs b/Language/Haskell/GhcMod/Ghc.hs
index b2259db..0d2cd20 100644
--- a/Language/Haskell/GhcMod/Ghc.hs
+++ b/Language/Haskell/GhcMod/Ghc.hs
@@ -1,9 +1,6 @@
 module Language.Haskell.GhcMod.Ghc (
-  -- * Converting the 'Ghc' monad to the 'IO' monad
-    withGHC
-  , withGHC'
   -- * 'SymMdlDb'
-  , Symbol
+    Symbol
   , SymMdlDb
   , getSymMdlDb
   , lookupSym

From 81c58585a2a0c048e59f0162379057be80f497ec Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Daniel=20Gr=C3=B6ber?= <dxld@darkboxed.org>
Date: Fri, 11 Jul 2014 10:43:51 +0200
Subject: [PATCH 3/5] Add functions for dealing with packages, modules and
 bindings to GHCApi

---
 Language/Haskell/GhcMod/GHCApi.hs | 89 +++++++++++++++++++++++++++++--
 Language/Haskell/GhcMod/Types.hs  |  6 +++
 test/GhcApiSpec.hs                | 31 +++++++++++
 3 files changed, 123 insertions(+), 3 deletions(-)
 create mode 100644 test/GhcApiSpec.hs

diff --git a/Language/Haskell/GhcMod/GHCApi.hs b/Language/Haskell/GhcMod/GHCApi.hs
index ba98bfe..5fc9f6f 100644
--- a/Language/Haskell/GhcMod/GHCApi.hs
+++ b/Language/Haskell/GhcMod/GHCApi.hs
@@ -9,6 +9,13 @@ module Language.Haskell.GhcMod.GHCApi (
   , withCmdFlags
   , setNoWaringFlags
   , setAllWaringFlags
+  , ghcPkgDb
+  , package
+  , modules
+  , findModule
+  , moduleInfo
+  , localModuleInfo
+  , bindings
   ) where
 
 import Language.Haskell.GhcMod.CabalApi
@@ -19,14 +26,17 @@ import Language.Haskell.GhcMod.Types
 
 import Control.Applicative ((<$>))
 import Control.Monad (forM, void)
+import Distribution.Package (InstalledPackageId(..))
 import Data.Maybe (isJust, fromJust)
-import Exception (ghandle, SomeException(..))
+import qualified Data.Map.Strict as M
 import GHC (DynFlags(..), GhcLink(..), HscTarget(..), LoadHowMuch(..))
 import qualified GHC as G
 import GhcMonad
 import GHC.Paths (libdir)
-import System.Exit (exitSuccess)
-import System.IO (hPutStr, hPrint, stderr)
+import qualified Packages as G
+import qualified Module as G
+import qualified OccName as G
+
 import System.IO.Unsafe (unsafePerformIO)
 
 ----------------------------------------------------------------
@@ -178,3 +188,76 @@ allWarningFlags = unsafePerformIO $ do
         df <- G.getSessionDynFlags
         df' <- addCmdOpts ["-Wall"] df
         return $ G.warningFlags df'
+
+----------------------------------------------------------------
+-- get Packages,Modules,Bindings
+
+ghcPkgDb :: GhcMonad m => m PkgDb
+ghcPkgDb = M.fromList <$>
+    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
+
+modules :: G.PackageConfig -> [ModuleString]
+modules = map G.moduleNameString . G.exposedModules
+
+findModule :: ModuleString -> PkgDb -> [Package]
+findModule m db = do
+  M.elems $ package `M.map` (containsModule `M.filter` db)
+ where
+    containsModule :: G.PackageConfig -> Bool
+    containsModule pkgConf =
+        G.mkModuleName m `elem` G.exposedModules pkgConf
+
+
+ghcPkgId :: Package -> G.PackageId
+ghcPkgId (name,_,_) =
+    -- TODO: Adding the package version too breaks 'findModule' for some reason
+    -- this isn't a big deal since in the common case where we're in a cabal
+    -- project we just use cabal's view of package dependencies anyways so we're
+    -- guaranteed to only have one version of each package exposed. However when
+    -- 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
+
+
+----------------------------------------------------------------
+-- 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"
diff --git a/Language/Haskell/GhcMod/Types.hs b/Language/Haskell/GhcMod/Types.hs
index 4dfb161..b42b018 100644
--- a/Language/Haskell/GhcMod/Types.hs
+++ b/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,6 +90,9 @@ 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
 
diff --git a/test/GhcApiSpec.hs b/test/GhcApiSpec.hs
new file mode 100644
index 0000000..71d2c27
--- /dev/null
+++ b/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"]

From 503e8cbe06cd980734a82aeb9f0a70a61071e750 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Daniel=20Gr=C3=B6ber?= <dxld@darkboxed.org>
Date: Sat, 12 Jul 2014 02:53:59 +0200
Subject: [PATCH 4/5] Move DynFlag related functions from GHCApi to another
 module

---
 Language/Haskell/GhcMod/DynFlags.hs | 108 ++++++++++++++++++++++++++++
 Language/Haskell/GhcMod/GHCApi.hs   | 105 ++-------------------------
 ghc-mod.cabal                       |   1 +
 3 files changed, 113 insertions(+), 101 deletions(-)
 create mode 100644 Language/Haskell/GhcMod/DynFlags.hs

diff --git a/Language/Haskell/GhcMod/DynFlags.hs b/Language/Haskell/GhcMod/DynFlags.hs
new file mode 100644
index 0000000..2589ff2
--- /dev/null
+++ b/Language/Haskell/GhcMod/DynFlags.hs
@@ -0,0 +1,108 @@
+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(..), GhcLink(..), HscTarget(..), LoadHowMuch(..))
+import qualified GHC as G
+import GhcMonad
+import GHC.Paths (libdir)
+
+import System.IO.Unsafe (unsafePerformIO)
+
+data Build = CabalPkg | SingleFile deriving Eq
+
+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
+    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'
+
+----------------------------------------------------------------
diff --git a/Language/Haskell/GhcMod/GHCApi.hs b/Language/Haskell/GhcMod/GHCApi.hs
index 5fc9f6f..4a28bfa 100644
--- a/Language/Haskell/GhcMod/GHCApi.hs
+++ b/Language/Haskell/GhcMod/GHCApi.hs
@@ -21,15 +21,16 @@ module Language.Haskell.GhcMod.GHCApi (
 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 (forM, void)
+import Control.Monad (void)
 import Distribution.Package (InstalledPackageId(..))
 import Data.Maybe (isJust, fromJust)
-import qualified Data.Map.Strict as M
-import GHC (DynFlags(..), GhcLink(..), HscTarget(..), LoadHowMuch(..))
+import qualified Data.Map as M
+import GHC (DynFlags(..))
 import qualified GHC as G
 import GhcMonad
 import GHC.Paths (libdir)
@@ -37,8 +38,6 @@ import qualified Packages as G
 import qualified Module as G
 import qualified OccName as G
 
-import System.IO.Unsafe (unsafePerformIO)
-
 ----------------------------------------------------------------
 
 -- | Obtaining the directory for system libraries.
@@ -50,8 +49,6 @@ systemLibDir = libdir
 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.
@@ -95,100 +92,6 @@ initSession build Options {..} CompilerOptions {..} = do
       $ 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
-    G.runGhc (Just systemLibDir) 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 systemLibDir) $ do
-        df <- G.getSessionDynFlags
-        df' <- addCmdOpts ["-Wall"] df
-        return $ G.warningFlags df'
-
 ----------------------------------------------------------------
 -- get Packages,Modules,Bindings
 
diff --git a/ghc-mod.cabal b/ghc-mod.cabal
index 1cfb162..8273417 100644
--- a/ghc-mod.cabal
+++ b/ghc-mod.cabal
@@ -67,6 +67,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

From b6896a481a7fe14ab4db420b7304ac3f7abdd7de Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Daniel=20Gr=C3=B6ber?= <dxld@darkboxed.org>
Date: Sat, 12 Jul 2014 03:30:06 +0200
Subject: [PATCH 5/5] Move `initializeFlagsWithCradle` to Monad.hs

---
 Language/Haskell/GhcMod/Browse.hs   |  2 +-
 Language/Haskell/GhcMod/Check.hs    |  2 +-
 Language/Haskell/GhcMod/Debug.hs    |  6 +--
 Language/Haskell/GhcMod/GHCApi.hs   | 81 +----------------------------
 Language/Haskell/GhcMod/Ghc.hs      |  1 -
 Language/Haskell/GhcMod/Internal.hs | 12 +++--
 Language/Haskell/GhcMod/Logger.hs   |  2 +-
 Language/Haskell/GhcMod/Monad.hs    | 60 +++++++++++++++++++--
 Language/Haskell/GhcMod/SrcUtils.hs |  2 +-
 9 files changed, 71 insertions(+), 97 deletions(-)

diff --git a/Language/Haskell/GhcMod/Browse.hs b/Language/Haskell/GhcMod/Browse.hs
index a984235..72419b8 100644
--- a/Language/Haskell/GhcMod/Browse.hs
+++ b/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
diff --git a/Language/Haskell/GhcMod/Check.hs b/Language/Haskell/GhcMod/Check.hs
index 48dacc3..736c42f 100644
--- a/Language/Haskell/GhcMod/Check.hs
+++ b/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
diff --git a/Language/Haskell/GhcMod/Debug.hs b/Language/Haskell/GhcMod/Debug.hs
index b3ce715..2278ad2 100644
--- a/Language/Haskell/GhcMod/Debug.hs
+++ b/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 ->
diff --git a/Language/Haskell/GhcMod/GHCApi.hs b/Language/Haskell/GhcMod/GHCApi.hs
index 4a28bfa..b765698 100644
--- a/Language/Haskell/GhcMod/GHCApi.hs
+++ b/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"
diff --git a/Language/Haskell/GhcMod/Ghc.hs b/Language/Haskell/GhcMod/Ghc.hs
index 0d2cd20..074a218 100644
--- a/Language/Haskell/GhcMod/Ghc.hs
+++ b/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
diff --git a/Language/Haskell/GhcMod/Internal.hs b/Language/Haskell/GhcMod/Internal.hs
index 99566e6..a405ff5 100644
--- a/Language/Haskell/GhcMod/Internal.hs
+++ b/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
diff --git a/Language/Haskell/GhcMod/Logger.hs b/Language/Haskell/GhcMod/Logger.hs
index dfe0363..5d16788 100644
--- a/Language/Haskell/GhcMod/Logger.hs
+++ b/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
diff --git a/Language/Haskell/GhcMod/Monad.hs b/Language/Haskell/GhcMod/Monad.hs
index 9220e22..bf92caa 100644
--- a/Language/Haskell/GhcMod/Monad.hs
+++ b/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
diff --git a/Language/Haskell/GhcMod/SrcUtils.hs b/Language/Haskell/GhcMod/SrcUtils.hs
index c5438a2..059bcad 100644
--- a/Language/Haskell/GhcMod/SrcUtils.hs
+++ b/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)