diff --git a/Language/Haskell/GhcMod/Browse.hs b/Language/Haskell/GhcMod/Browse.hs index b29fefd..4e6a00f 100644 --- a/Language/Haskell/GhcMod/Browse.hs +++ b/Language/Haskell/GhcMod/Browse.hs @@ -11,11 +11,11 @@ import Exception (ghandle) import FastString (mkFastString) import GHC (GhcException(CmdLineError), ModuleInfo, Name, TyThing, DynFlags, Type, TyCon) import qualified GHC as G -import Language.Haskell.GhcMod.Doc (showPage, styleUnqualified) -import Language.Haskell.GhcMod.DynFlags -import Language.Haskell.GhcMod.Gap -import Language.Haskell.GhcMod.Monad import Language.Haskell.GhcMod.Convert +import Language.Haskell.GhcMod.Doc (showPage, styleUnqualified) +import Language.Haskell.GhcMod.Gap +import Language.Haskell.GhcMod.Monad (IOish, GhcModT, options) +import Language.Haskell.GhcMod.Target (setTargetFiles) import Language.Haskell.GhcMod.Types import Name (getOccString) import Outputable (ppr, Outputable) diff --git a/Language/Haskell/GhcMod/Check.hs b/Language/Haskell/GhcMod/Check.hs index cd6591c..594ee9e 100644 --- a/Language/Haskell/GhcMod/Check.hs +++ b/Language/Haskell/GhcMod/Check.hs @@ -9,7 +9,8 @@ import Control.Applicative ((<$>)) import Language.Haskell.GhcMod.DynFlags import qualified Language.Haskell.GhcMod.Gap as Gap import Language.Haskell.GhcMod.Logger -import Language.Haskell.GhcMod.Monad +import Language.Haskell.GhcMod.Monad (IOish, GhcModT, withErrorHandler) +import Language.Haskell.GhcMod.Target (setTargetFiles) ---------------------------------------------------------------- diff --git a/Language/Haskell/GhcMod/DynFlags.hs b/Language/Haskell/GhcMod/DynFlags.hs index 43438f6..0134912 100644 --- a/Language/Haskell/GhcMod/DynFlags.hs +++ b/Language/Haskell/GhcMod/DynFlags.hs @@ -1,9 +1,8 @@ module Language.Haskell.GhcMod.DynFlags where import Control.Applicative ((<$>)) -import Control.Monad (forM, void, (>=>)) -import DynFlags (ExtensionFlag(..), xopt) -import GHC (DynFlags(..), GhcMode(..), GhcLink(..), HscTarget(..), LoadHowMuch(..)) +import Control.Monad (void) +import GHC (DynFlags(..), GhcMode(..), GhcLink(..), HscTarget(..)) import qualified GHC as G import GHC.Paths (libdir) import GhcMonad @@ -67,36 +66,6 @@ addCmdOpts cmdOpts df = ---------------------------------------------------------------- --- | 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 - xs <- G.depanal [] False - -- FIXME, checking state - loadTargets $ needsFallback xs - where - loadTargets False = do - -- Reporting error A and error B - void $ G.load LoadAllTargets - mss <- filter (\x -> G.ms_hspp_file x `elem` files) <$> G.getModuleGraph - -- Reporting error B and error C - mapM_ (G.parseModule >=> G.typecheckModule >=> G.desugarModule) mss - -- Error B duplicates. But we cannot ignore both error reportings, - -- sigh. So, the logger makes log messages unique by itself. - loadTargets True = do - df <- G.getSessionDynFlags - void $ G.setSessionDynFlags (setModeIntelligent df) - void $ G.load LoadAllTargets - -needsFallback :: G.ModuleGraph -> Bool -needsFallback = any (hasTHorQQ . G.ms_hspp_opts) - where - hasTHorQQ :: DynFlags -> Bool - hasTHorQQ dflags = any (`xopt` dflags) [Opt_TemplateHaskell, Opt_QuasiQuotes] - ----------------------------------------------------------------- - -- | Return the 'DynFlags' currently in use in the GHC session. getDynamicFlags :: IO DynFlags getDynamicFlags = G.runGhc (Just libdir) G.getSessionDynFlags diff --git a/Language/Haskell/GhcMod/GHCApi.hs b/Language/Haskell/GhcMod/GHCApi.hs index a3ac817..2cc22f3 100644 --- a/Language/Haskell/GhcMod/GHCApi.hs +++ b/Language/Haskell/GhcMod/GHCApi.hs @@ -11,7 +11,8 @@ module Language.Haskell.GhcMod.GHCApi ( ) where import Language.Haskell.GhcMod.GhcPkg -import Language.Haskell.GhcMod.DynFlags +import Language.Haskell.GhcMod.Monad (IOish, GhcModT) +import Language.Haskell.GhcMod.Target (setTargetFiles) import Language.Haskell.GhcMod.Types import Control.Applicative ((<$>)) @@ -64,10 +65,10 @@ type Binding = String -- should look for @module@ in the working directory. -- -- To map a 'ModuleString' to a package see 'findModule' -moduleInfo :: GhcMonad m +moduleInfo :: IOish m => Maybe Package -> ModuleString - -> m (Maybe G.ModuleInfo) + -> GhcModT m (Maybe G.ModuleInfo) moduleInfo mpkg mdl = do let mdlName = G.mkModuleName mdl mfsPkgId = G.packageIdFS . ghcPkgId <$> mpkg @@ -78,7 +79,7 @@ moduleInfo mpkg mdl = do Just _ -> return () Nothing -> setTargetFiles [mdl] -localModuleInfo :: GhcMonad m => ModuleString -> m (Maybe G.ModuleInfo) +localModuleInfo :: IOish m => ModuleString -> GhcModT m (Maybe G.ModuleInfo) localModuleInfo mdl = moduleInfo Nothing mdl bindings :: G.ModuleInfo -> [Binding] diff --git a/Language/Haskell/GhcMod/Internal.hs b/Language/Haskell/GhcMod/Internal.hs index a405ff5..52e4858 100644 --- a/Language/Haskell/GhcMod/Internal.hs +++ b/Language/Haskell/GhcMod/Internal.hs @@ -40,6 +40,7 @@ import Language.Haskell.GhcMod.CabalApi import Language.Haskell.GhcMod.DynFlags import Language.Haskell.GhcMod.GHCChoice import Language.Haskell.GhcMod.Logger +import Language.Haskell.GhcMod.Target import Language.Haskell.GhcMod.Types -- | Obtaining the directory for ghc system libraries. diff --git a/Language/Haskell/GhcMod/SrcUtils.hs b/Language/Haskell/GhcMod/SrcUtils.hs index 059bcad..c774032 100644 --- a/Language/Haskell/GhcMod/SrcUtils.hs +++ b/Language/Haskell/GhcMod/SrcUtils.hs @@ -9,17 +9,19 @@ import Data.Generics import Data.Maybe (fromMaybe) import Data.Ord as O import GHC (LHsExpr, LPat, Id, DynFlags, SrcSpan, Type, Located, ParsedSource, RenamedSource, TypecheckedSource, GenLocated(L)) -import GhcMonad import qualified GHC as G import GHC.SYB.Utils (Stage(..), everythingStaged) +import GhcMonad +import qualified Language.Haskell.Exts.Annotated as HE import Language.Haskell.GhcMod.Doc (showOneLine, getStyle) import Language.Haskell.GhcMod.DynFlags import Language.Haskell.GhcMod.Gap (HasType(..), setWarnTypedHoles, setDeferTypeErrors) import qualified Language.Haskell.GhcMod.Gap as Gap +import Language.Haskell.GhcMod.Monad (IOish, GhcModT) +import Language.Haskell.GhcMod.Target (setTargetFiles) +import OccName (OccName) import Outputable (PprStyle) import TcHsSyn (hsPatType) -import OccName (OccName) -import qualified Language.Haskell.Exts.Annotated as HE ---------------------------------------------------------------- @@ -79,7 +81,7 @@ pretty dflag style = showOneLine dflag style . Gap.typeForUser ---------------------------------------------------------------- -inModuleContext ::GhcMonad m => FilePath -> (DynFlags -> PprStyle -> m a) -> m a +inModuleContext :: IOish m => FilePath -> (DynFlags -> PprStyle -> GhcModT m a) -> GhcModT m a inModuleContext file action = withDynFlags (setWarnTypedHoles . setDeferTypeErrors . setNoWaringFlags) $ do setTargetFiles [file] diff --git a/Language/Haskell/GhcMod/Target.hs b/Language/Haskell/GhcMod/Target.hs new file mode 100644 index 0000000..f0dfb07 --- /dev/null +++ b/Language/Haskell/GhcMod/Target.hs @@ -0,0 +1,39 @@ +module Language.Haskell.GhcMod.Target ( + setTargetFiles + ) where + +import Control.Applicative ((<$>)) +import Control.Monad (forM, void, (>=>)) +import DynFlags (ExtensionFlag(..), xopt) +import GHC (DynFlags(..), LoadHowMuch(..)) +import qualified GHC as G +import Language.Haskell.GhcMod.DynFlags +import Language.Haskell.GhcMod.Monad (IOish, GhcModT) + +-- | Set the files as targets and load them. +setTargetFiles :: IOish m => [FilePath] -> GhcModT m () +setTargetFiles files = do + targets <- forM files $ \file -> G.guessTarget file Nothing + G.setTargets targets + xs <- G.depanal [] False + -- FIXME, checking state + loadTargets $ needsFallback xs + where + loadTargets False = do + -- Reporting error A and error B + void $ G.load LoadAllTargets + mss <- filter (\x -> G.ms_hspp_file x `elem` files) <$> G.getModuleGraph + -- Reporting error B and error C + mapM_ (G.parseModule >=> G.typecheckModule >=> G.desugarModule) mss + -- Error B duplicates. But we cannot ignore both error reportings, + -- sigh. So, the logger makes log messages unique by itself. + loadTargets True = do + df <- G.getSessionDynFlags + void $ G.setSessionDynFlags (setModeIntelligent df) + void $ G.load LoadAllTargets + +needsFallback :: G.ModuleGraph -> Bool +needsFallback = any (hasTHorQQ . G.ms_hspp_opts) + where + hasTHorQQ :: DynFlags -> Bool + hasTHorQQ dflags = any (`xopt` dflags) [Opt_TemplateHaskell, Opt_QuasiQuotes] diff --git a/ghc-mod.cabal b/ghc-mod.cabal index 0ce7704..f09f10e 100644 --- a/ghc-mod.cabal +++ b/ghc-mod.cabal @@ -83,6 +83,7 @@ Library Language.Haskell.GhcMod.PkgDoc Language.Haskell.GhcMod.Read Language.Haskell.GhcMod.SrcUtils + Language.Haskell.GhcMod.Target Language.Haskell.GhcMod.Types Language.Haskell.GhcMod.Utils Build-Depends: base >= 4.0 && < 5