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