diff --git a/.gitignore b/.gitignore index 1558560..f280993 100644 --- a/.gitignore +++ b/.gitignore @@ -16,3 +16,5 @@ cabal.sandbox.config # For instance, .#Help.page # .#* cabal-dev +/TAGS +/tags diff --git a/Language/Haskell/GhcMod/Debug.hs b/Language/Haskell/GhcMod/Debug.hs index 42abedb..54e85d2 100644 --- a/Language/Haskell/GhcMod/Debug.hs +++ b/Language/Haskell/GhcMod/Debug.hs @@ -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 diff --git a/Language/Haskell/GhcMod/Internal.hs b/Language/Haskell/GhcMod/Internal.hs index 1e01d7b..bb9fae7 100644 --- a/Language/Haskell/GhcMod/Internal.hs +++ b/Language/Haskell/GhcMod/Internal.hs @@ -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 diff --git a/Language/Haskell/GhcMod/Monad/Types.hs b/Language/Haskell/GhcMod/Monad/Types.hs index 5204c35..cfcb29b 100644 --- a/Language/Haskell/GhcMod/Monad/Types.hs +++ b/Language/Haskell/GhcMod/Monad/Types.hs @@ -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 diff --git a/Language/Haskell/GhcMod/Target.hs b/Language/Haskell/GhcMod/Target.hs index 6c61f9e..c02d38e 100644 --- a/Language/Haskell/GhcMod/Target.hs +++ b/Language/Haskell/GhcMod/Target.hs @@ -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 diff --git a/src/GHCMod.hs b/src/GHCMod.hs index 8e94ab7..57c914e 100644 --- a/src/GHCMod.hs +++ b/src/GHCMod.hs @@ -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 diff --git a/src/Misc.hs b/src/Misc.hs index 834f0c2..2064a7f 100644 --- a/src/Misc.hs +++ b/src/Misc.hs @@ -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) ----------------------------------------------------------------