This commit is contained in:
Daniel Gröber 2015-08-13 10:17:14 +02:00
commit 312a8c81fb
7 changed files with 51 additions and 13 deletions

2
.gitignore vendored
View File

@ -16,3 +16,5 @@ cabal.sandbox.config
# For instance, .#Help.page
# .#*
cabal-dev
/TAGS
/tags

View File

@ -12,7 +12,6 @@ import Language.Haskell.GhcMod.Convert
import Language.Haskell.GhcMod.Monad
import Language.Haskell.GhcMod.Types
import Language.Haskell.GhcMod.Internal
import Language.Haskell.GhcMod.CabalHelper
import Language.Haskell.GhcMod.Target
import Language.Haskell.GhcMod.Pretty
import Language.Haskell.GhcMod.Utils
@ -44,8 +43,8 @@ debugInfo = do
cabalDebug :: IOish m => GhcModT m [String]
cabalDebug = do
crdl@Cradle {..} <- cradle
mcs <- resolveGmComponents Nothing =<< mapM (resolveEntrypoint crdl) =<< getComponents
Cradle {..} <- cradle
mcs <- cabalResolvedComponents
let entrypoints = Map.map gmcEntrypoints mcs
graphs = Map.map gmcHomeModuleGraph mcs
opts = Map.map gmcGhcOpts mcs
@ -69,8 +68,7 @@ componentInfo ts = do
-- useful function from there.
crdl <- cradle
sefnmn <- Set.fromList `liftM` mapM guessModuleFile ts
comps <- mapM (resolveEntrypoint crdl) =<< getComponents
mcs <- resolveGmComponents Nothing comps
mcs <- cabalResolvedComponents
let
mdlcs = moduleComponents mcs `zipMap` Set.toList sefnmn
candidates = findCandidates $ map snd mdlcs

View File

@ -8,6 +8,9 @@ module Language.Haskell.GhcMod.Internal (
, PackageVersion
, PackageId
, IncludeDir
, GmlT(..)
, MonadIO(..)
, GmEnv(..)
-- * Various Paths
, ghcLibDir
, ghcModExecutable
@ -20,9 +23,18 @@ module Language.Haskell.GhcMod.Internal (
, GhcModState
, CompilerMode(..)
, GhcModLog
, GmLog(..)
, GmLogLevel(..)
, gmSetLogLevel
-- * Monad utilities
, runGhcModT'
, hoistGhcModT
, runGmlT
, runGmlT'
, gmlGetSession
, gmlSetSession
, loadTargets
, cabalResolvedComponents
-- ** Accessing 'GhcModEnv' and 'GhcModState'
, options
, cradle
@ -35,13 +47,20 @@ module Language.Haskell.GhcMod.Internal (
, World
, getCurrentWorld
, didWorldChange
-- * Cabal Helper
, ModulePath(..)
, GmComponent(..)
, GmComponentType(..)
, GmModuleGraph(..)
) where
import GHC.Paths (libdir)
import Language.Haskell.GhcMod.Target
import Language.Haskell.GhcMod.DynFlags
import Language.Haskell.GhcMod.Error
import Language.Haskell.GhcMod.Logger
import Language.Haskell.GhcMod.Logging
import Language.Haskell.GhcMod.Monad
import Language.Haskell.GhcMod.Types
import Language.Haskell.GhcMod.Utils

View File

@ -51,6 +51,8 @@ module Language.Haskell.GhcMod.Monad.Types (
-- * Re-exporting convenient stuff
, MonadIO
, liftIO
, gmlGetSession
, gmlSetSession
) where
-- MonadUtils of GHC 7.6 or earlier defines its own MonadIO.
@ -352,13 +354,22 @@ gmLiftWithInner f = liftWith f >>= restoreT . return
type GmGhc m = (IOish m, GhcMonad m)
instance (MonadIO m, MonadBaseControl IO m) => GhcMonad (GmlT m) where
getSession = do
getSession = gmlGetSession
setSession = gmlSetSession
-- ---------------------------------------------------------------------
gmlGetSession :: (MonadIO m, MonadBaseControl IO m) => GmlT m HscEnv
gmlGetSession = do
ref <- gmgsSession . fromJust . gmGhcSession <$> gmsGet
GHC.liftIO $ readIORef ref
setSession a = do
gmlSetSession :: (MonadIO m, MonadBaseControl IO m) => HscEnv -> GmlT m ()
gmlSetSession a = do
ref <- gmgsSession . fromJust . gmGhcSession <$> gmsGet
GHC.liftIO $ flip writeIORef a ref
-- ---------------------------------------------------------------------
instance GhcMonad LightGhc where
getSession = (GHC.liftIO . readIORef) =<< LightGhc ask
setSession a = (GHC.liftIO . flip writeIORef a) =<< LightGhc ask

View File

@ -184,11 +184,9 @@ targetGhcOptions crdl sefnmn = do
cabalOpts :: Cradle -> GhcModT m [String]
cabalOpts Cradle{..} = do
comps <- mapM (resolveEntrypoint crdl) =<< getComponents
mcs <- cached cradleRootDir resolvedComponentsCache comps
mcs <- cabalResolvedComponents
let mdlcs = moduleComponents mcs `zipMap` Set.toList sefnmn
cns = map gmcName comps
candidates = findCandidates $ map snd mdlcs
let noCandidates = Set.null candidates
@ -196,7 +194,10 @@ targetGhcOptions crdl sefnmn = do
if noCandidates && noModuleHasAnyAssignment
then do
gmLog GmWarning "" $ strDoc $ "Could not find a component assignment, falling back to picking first component in cabal file."
-- First component should be ChLibName, if no lib will take lexically first exe.
let cns = filter (/= ChSetupHsName) $ Map.keys mcs
gmLog GmWarning "" $ strDoc $ "Could not find a component assignment, falling back to picking library component in cabal file."
return $ gmcGhcOpts $ fromJust $ Map.lookup (head cns) mcs
else do
when noCandidates $
@ -476,3 +477,10 @@ needsFallback = any $ \ms ->
#if __GLASGOW_HASKELL__ >= 708
|| (Opt_PatternSynonyms `xopt` df)
#endif
cabalResolvedComponents :: (IOish m) =>
GhcModT m (Map ChComponentName (GmComponent 'GMCResolved (Set ModulePath)))
cabalResolvedComponents = do
crdl@(Cradle{..}) <- cradle
comps <- mapM (resolveEntrypoint crdl) =<< getComponents
cached cradleRootDir resolvedComponentsCache comps

View File

@ -14,7 +14,7 @@ import Data.Char (isSpace)
import Data.Maybe
import Exception
import Language.Haskell.GhcMod
import Language.Haskell.GhcMod.Internal
import Language.Haskell.GhcMod.Internal hiding (MonadIO,liftIO)
import Paths_ghc_mod
import System.Console.GetOpt (OptDescr(..), ArgDescr(..), ArgOrder(..))
import qualified System.Console.GetOpt as O

View File

@ -13,7 +13,7 @@ import Data.IORef (IORef, newIORef, readIORef, writeIORef)
import Prelude
import Language.Haskell.GhcMod
import Language.Haskell.GhcMod.Internal
import Language.Haskell.GhcMod.Internal hiding (MonadIO,liftIO)
----------------------------------------------------------------