From 82ae176492a3e49b942b0b84316602cb2b133466 Mon Sep 17 00:00:00 2001 From: Alan Zimmerman Date: Sun, 14 Apr 2019 15:11:02 +0200 Subject: [PATCH 01/20] Add Haskell.Ide.Engine.PluginApi. This is initially based on the ghc-mod-core calls that HaRe is making. --- .../Haskell/Ide/Engine/PluginApi.hs | 38 +++++++++++++++++++ hie-plugin-api/hie-plugin-api.cabal | 5 ++- 2 files changed, 41 insertions(+), 2 deletions(-) create mode 100644 hie-plugin-api/Haskell/Ide/Engine/PluginApi.hs diff --git a/hie-plugin-api/Haskell/Ide/Engine/PluginApi.hs b/hie-plugin-api/Haskell/Ide/Engine/PluginApi.hs new file mode 100644 index 000000000..d04b03602 --- /dev/null +++ b/hie-plugin-api/Haskell/Ide/Engine/PluginApi.hs @@ -0,0 +1,38 @@ +-- | This module provides an API that software intented to be +-- integrated into HIE can use, so that they can make use of the +-- shared BIOS features. + +module Haskell.Ide.Engine.PluginApi + ( + -- ** Re-exported from ghc-mod + GM.Options(..) + , GM.defaultOptions + , GM.getModulesGhc' + , GM.mkRevRedirMapFunc + , GM.cradle + , GM.Cradle(..) + + , GM.GmModuleGraph(..) + , GM.ModulePath(..) + , GM.GmComponent(..) + , GM.GmComponentType(..) + , GM.cabalResolvedComponents + -- probably remove the next ones + , GM.IOish + , GM.MonadIO(..) + , GM.GmOut(..) + , GM.GhcModT + , GM.runGhcModT + , GM.GmlT(..) + , GM.GmEnv(..) + , GM.gmlGetSession + , GM.gmlSetSession + ) where + +import qualified GhcMod.Monad.Newtypes as GM (GmlT(..)) +import qualified GhcMod.Monad.Out as GM (GmOut(..)) +import qualified GhcMod.Monad.Types as GM (GmEnv(..),IOish,gmlGetSession,gmlSetSession,cradle) +import qualified GhcMod.Target as GM (cabalResolvedComponents) +import qualified GhcMod.Types as GM (ModulePath(..),GmModuleGraph(..),GmComponent(..),GmComponentType(..),Cradle(..),MonadIO(..)) +import qualified GhcMod.Utils as GM (mkRevRedirMapFunc) +import qualified GhcModCore as GM (Options(..),defaultOptions,getModulesGhc',GhcModT,runGhcModT) diff --git a/hie-plugin-api/hie-plugin-api.cabal b/hie-plugin-api/hie-plugin-api.cabal index fb20d8506..5ea32d1c7 100644 --- a/hie-plugin-api/hie-plugin-api.cabal +++ b/hie-plugin-api/hie-plugin-api.cabal @@ -1,5 +1,5 @@ name: hie-plugin-api -version: 0.6.0.0 +version: 0.8.0.0 synopsis: Haskell IDE API for plugin communication license: BSD3 license-file: LICENSE @@ -27,8 +27,9 @@ library Haskell.Ide.Engine.MonadFunctions Haskell.Ide.Engine.MonadTypes Haskell.Ide.Engine.MultiThreadState - Haskell.Ide.Engine.PluginsIdeMonads + Haskell.Ide.Engine.PluginApi Haskell.Ide.Engine.PluginUtils + Haskell.Ide.Engine.PluginsIdeMonads build-depends: base >= 4.9 && < 5 , Diff , aeson From d71de15df57439a006cd394357c85db42e901071 Mon Sep 17 00:00:00 2001 From: Alan Zimmerman Date: Sun, 14 Apr 2019 15:43:46 +0200 Subject: [PATCH 02/20] Expose ghc-mod features currently used in HaRe tests --- hie-plugin-api/Haskell/Ide/Engine/PluginApi.hs | 8 +++++++- 1 file changed, 7 insertions(+), 1 deletion(-) diff --git a/hie-plugin-api/Haskell/Ide/Engine/PluginApi.hs b/hie-plugin-api/Haskell/Ide/Engine/PluginApi.hs index d04b03602..703d15809 100644 --- a/hie-plugin-api/Haskell/Ide/Engine/PluginApi.hs +++ b/hie-plugin-api/Haskell/Ide/Engine/PluginApi.hs @@ -27,12 +27,18 @@ module Haskell.Ide.Engine.PluginApi , GM.GmEnv(..) , GM.gmlGetSession , GM.gmlSetSession + , GM.globalArgSpec + , GM.OutputOpts(..) + , GM.GmLogLevel(..) + , GM.OutputStyle(..) + , GM.LineSeparator(..) ) where import qualified GhcMod.Monad.Newtypes as GM (GmlT(..)) import qualified GhcMod.Monad.Out as GM (GmOut(..)) import qualified GhcMod.Monad.Types as GM (GmEnv(..),IOish,gmlGetSession,gmlSetSession,cradle) import qualified GhcMod.Target as GM (cabalResolvedComponents) -import qualified GhcMod.Types as GM (ModulePath(..),GmModuleGraph(..),GmComponent(..),GmComponentType(..),Cradle(..),MonadIO(..)) +import qualified GhcMod.Types as GM (ModulePath(..),GmModuleGraph(..),GmComponent(..),GmComponentType(..),Cradle(..),MonadIO(..),OutputOpts(..),GmLogLevel(..),OutputStyle(..),LineSeparator(..)) import qualified GhcMod.Utils as GM (mkRevRedirMapFunc) import qualified GhcModCore as GM (Options(..),defaultOptions,getModulesGhc',GhcModT,runGhcModT) +import qualified GhcMod.Options.Options as GM (globalArgSpec) From d645924167862f67a69d60d7a86cb61a0b51bc33 Mon Sep 17 00:00:00 2001 From: Alan Zimmerman Date: Sun, 14 Apr 2019 19:52:37 +0200 Subject: [PATCH 03/20] Add the HIE Monads --- hie-plugin-api/Haskell/Ide/Engine/PluginApi.hs | 16 ++++++++++++++++ 1 file changed, 16 insertions(+) diff --git a/hie-plugin-api/Haskell/Ide/Engine/PluginApi.hs b/hie-plugin-api/Haskell/Ide/Engine/PluginApi.hs index 703d15809..9706af5a4 100644 --- a/hie-plugin-api/Haskell/Ide/Engine/PluginApi.hs +++ b/hie-plugin-api/Haskell/Ide/Engine/PluginApi.hs @@ -17,7 +17,21 @@ module Haskell.Ide.Engine.PluginApi , GM.GmComponent(..) , GM.GmComponentType(..) , GM.cabalResolvedComponents + + -- * IDE monads + , HIE.IdeState(..) + , HIE.IdeGhcM + , HIE.runIdeGhcM + , HIE.IdeM + , HIE.runIdeM + , HIE.IdeDeferM + , HIE.MonadIde(..) + , HIE.iterT + , HIE.LiftsToGhc(..) + + -- probably remove the next ones + , GM.IOish , GM.MonadIO(..) , GM.GmOut(..) @@ -42,3 +56,5 @@ import qualified GhcMod.Types as GM (ModulePath(..),GmModuleGraph(..),G import qualified GhcMod.Utils as GM (mkRevRedirMapFunc) import qualified GhcModCore as GM (Options(..),defaultOptions,getModulesGhc',GhcModT,runGhcModT) import qualified GhcMod.Options.Options as GM (globalArgSpec) + +import Haskell.Ide.Engine.PluginsIdeMonads as HIE From ecced4fd7db8df49aaf4908953861a49dee16b11 Mon Sep 17 00:00:00 2001 From: Alan Zimmerman Date: Sat, 20 Apr 2019 18:18:06 +0200 Subject: [PATCH 04/20] Suport HaRe running in IdeGhcM --- hie-plugin-api/Haskell/Ide/Engine/PluginApi.hs | 2 +- hie-plugin-api/Haskell/Ide/Engine/PluginsIdeMonads.hs | 11 +++++++++++ 2 files changed, 12 insertions(+), 1 deletion(-) diff --git a/hie-plugin-api/Haskell/Ide/Engine/PluginApi.hs b/hie-plugin-api/Haskell/Ide/Engine/PluginApi.hs index 9706af5a4..75df6d534 100644 --- a/hie-plugin-api/Haskell/Ide/Engine/PluginApi.hs +++ b/hie-plugin-api/Haskell/Ide/Engine/PluginApi.hs @@ -22,6 +22,7 @@ module Haskell.Ide.Engine.PluginApi , HIE.IdeState(..) , HIE.IdeGhcM , HIE.runIdeGhcM + , HIE.runIdeGhcMBare , HIE.IdeM , HIE.runIdeM , HIE.IdeDeferM @@ -29,7 +30,6 @@ module Haskell.Ide.Engine.PluginApi , HIE.iterT , HIE.LiftsToGhc(..) - -- probably remove the next ones , GM.IOish diff --git a/hie-plugin-api/Haskell/Ide/Engine/PluginsIdeMonads.hs b/hie-plugin-api/Haskell/Ide/Engine/PluginsIdeMonads.hs index 8de813064..9698a7120 100644 --- a/hie-plugin-api/Haskell/Ide/Engine/PluginsIdeMonads.hs +++ b/hie-plugin-api/Haskell/Ide/Engine/PluginsIdeMonads.hs @@ -46,6 +46,7 @@ module Haskell.Ide.Engine.PluginsIdeMonads , IdeState(..) , IdeGhcM , runIdeGhcM + , runIdeGhcMBare , IdeM , runIdeM , IdeDeferM @@ -322,6 +323,16 @@ runIdeGhcM ghcModOptions plugins mlf stateVar f = do Left err -> liftIO $ throwIO err Right res -> return res +-- | Run an IdeGhcM in an external context (e.g. HaRe), with no plugins or LSP functions +runIdeGhcMBare :: GM.Options -> IdeGhcM a -> IO a +runIdeGhcMBare ghcModOptions f = do + let + plugins = IdePlugins Map.empty + mlf = Nothing + initialState = IdeState emptyModuleCache Map.empty Map.empty Nothing + stateVar <- newTVarIO initialState + runIdeGhcM ghcModOptions plugins mlf stateVar f + -- | A computation that is deferred until the module is cached. -- Note that the module may not typecheck, in which case 'UriCacheFailed' is passed data Defer a = Defer FilePath (UriCacheResult -> a) deriving Functor From f5ea4b3f64b0578dc034e42e84d3ff982e1459a6 Mon Sep 17 00:00:00 2001 From: Alan Zimmerman Date: Sun, 21 Apr 2019 14:15:34 +0200 Subject: [PATCH 05/20] Move setTypecheckedModule into hie-plugin-api --- hie-plugin-api/hie-plugin-api.cabal | 1 + src/Haskell/Ide/Engine/Plugin/GhcMod.hs | 187 +++---------------- src/Haskell/Ide/Engine/Transport/LspStdio.hs | 4 +- test/unit/GhcModPluginSpec.hs | 1 + test/unit/HaRePluginSpec.hs | 2 +- 5 files changed, 27 insertions(+), 168 deletions(-) diff --git a/hie-plugin-api/hie-plugin-api.cabal b/hie-plugin-api/hie-plugin-api.cabal index cf47c569c..252abdf94 100644 --- a/hie-plugin-api/hie-plugin-api.cabal +++ b/hie-plugin-api/hie-plugin-api.cabal @@ -22,6 +22,7 @@ library Haskell.Ide.Engine.Compat Haskell.Ide.Engine.Config Haskell.Ide.Engine.Context + Haskell.Ide.Engine.Ghc Haskell.Ide.Engine.GhcModuleCache Haskell.Ide.Engine.ModuleCache Haskell.Ide.Engine.MonadFunctions diff --git a/src/Haskell/Ide/Engine/Plugin/GhcMod.hs b/src/Haskell/Ide/Engine/Plugin/GhcMod.hs index 92b1cdc04..13f5d0c2a 100644 --- a/src/Haskell/Ide/Engine/Plugin/GhcMod.hs +++ b/src/Haskell/Ide/Engine/Plugin/GhcMod.hs @@ -5,34 +5,42 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TupleSections #-} {-# LANGUAGE TypeFamilies #-} -module Haskell.Ide.Engine.Plugin.GhcMod where +module Haskell.Ide.Engine.Plugin.GhcMod + ( + ghcmodDescriptor + + -- * For tests + , Bindings(..) + , FunctionSig(..) + , InfoParams(..) + , TypeDef(..) + , TypeParams(..) + , ValidSubstitutions(..) + , extractHoleSubstitutions + , extractMissingSignature + , extractRenamableTerms + , extractUnusedTerm + , infoCmd' + , lintCmd' + , newTypeCmd + , symbolProvider + ) where -import Bag -import Control.Monad.IO.Class import Control.Lens hiding (cons, children) import Data.Aeson import Data.Function import qualified Data.HashMap.Strict as HM -import Data.IORef import Data.List -import qualified Data.Map.Strict as Map import Data.Maybe import Data.Monoid ((<>)) -import qualified Data.Set as Set import qualified Data.Text as T -import ErrUtils import Name import GHC.Generics import qualified GhcMod as GM -import qualified GhcMod.DynFlags as GM -import qualified GhcMod.Error as GM import qualified GhcMod.Gap as GM -import qualified GhcMod.ModuleLoader as GM -import qualified GhcMod.Monad as GM import qualified GhcMod.SrcUtils as GM import qualified GhcMod.Types as GM -import qualified GhcMod.Utils as GM -import Haskell.Ide.Engine.MonadFunctions +import Haskell.Ide.Engine.Ghc import Haskell.Ide.Engine.MonadTypes import Haskell.Ide.Engine.PluginUtils import qualified Haskell.Ide.Engine.Support.HieExtras as Hie @@ -41,13 +49,11 @@ import qualified Language.Haskell.LSP.Types as LSP import qualified Language.Haskell.LSP.Types.Lens as LSP import Language.Haskell.Refact.API (hsNamessRdr) -import DynFlags import GHC -import IOEnv as G import HscTypes import DataCon import TcRnTypes -import Outputable (renderWithStyle, mkUserStyle, Depth(..)) +import Outputable (mkUserStyle, Depth(..)) -- --------------------------------------------------------------------- @@ -74,160 +80,11 @@ ghcmodDescriptor plId = PluginDescriptor -- --------------------------------------------------------------------- -type Diagnostics = Map.Map Uri (Set.Set Diagnostic) -type AdditionalErrs = [T.Text] - checkCmd :: CommandFunc Uri (Diagnostics, AdditionalErrs) checkCmd = CmdSync setTypecheckedModule -- --------------------------------------------------------------------- -lspSev :: Severity -> DiagnosticSeverity -lspSev SevWarning = DsWarning -lspSev SevError = DsError -lspSev SevFatal = DsError -lspSev SevInfo = DsInfo -lspSev _ = DsInfo - --- type LogAction = DynFlags -> WarnReason -> Severity -> SrcSpan -> PprStyle -> MsgDoc -> IO () -logDiag :: (FilePath -> FilePath) -> IORef AdditionalErrs -> IORef Diagnostics -> LogAction -logDiag rfm eref dref df _reason sev spn style msg = do - eloc <- srcSpan2Loc rfm spn - let msgTxt = T.pack $ renderWithStyle df msg style - case eloc of - Right (Location uri range) -> do - let update = Map.insertWith Set.union uri l - where l = Set.singleton diag - diag = Diagnostic range (Just $ lspSev sev) Nothing (Just "ghcmod") msgTxt Nothing - modifyIORef' dref update - Left _ -> do - modifyIORef' eref (msgTxt:) - return () - -unhelpfulSrcSpanErr :: T.Text -> IdeError -unhelpfulSrcSpanErr err = - IdeError PluginError - ("Unhelpful SrcSpan" <> ": \"" <> err <> "\"") - Null - -srcErrToDiag :: MonadIO m - => DynFlags - -> (FilePath -> FilePath) - -> SourceError -> m (Diagnostics, AdditionalErrs) -srcErrToDiag df rfm se = do - debugm "in srcErrToDiag" - let errMsgs = bagToList $ srcErrorMessages se - processMsg err = do - let sev = Just DsError - unqual = errMsgContext err - st = GM.mkErrStyle' df unqual - msgTxt = T.pack $ renderWithStyle df (pprLocErrMsg err) st - eloc <- srcSpan2Loc rfm $ errMsgSpan err - case eloc of - Right (Location uri range) -> - return $ Right (uri, Diagnostic range sev Nothing (Just "ghcmod") msgTxt Nothing) - Left _ -> return $ Left msgTxt - processMsgs [] = return (Map.empty,[]) - processMsgs (x:xs) = do - res <- processMsg x - (m,es) <- processMsgs xs - case res of - Right (uri, diag) -> - return (Map.insertWith Set.union uri (Set.singleton diag) m, es) - Left e -> return (m, e:es) - processMsgs errMsgs - -myWrapper :: GM.IOish m - => (FilePath -> FilePath) - -> GM.GmlT m () - -> GM.GmlT m (Diagnostics, AdditionalErrs) -myWrapper rfm action = do - env <- getSession - diagRef <- liftIO $ newIORef Map.empty - errRef <- liftIO $ newIORef [] - let setLogger df = df { log_action = logDiag rfm errRef diagRef } - setDeferTypedHoles = setGeneralFlag' Opt_DeferTypedHoles - ghcErrRes msg = (Map.empty, [T.pack msg]) - handlers = errorHandlers ghcErrRes (srcErrToDiag (hsc_dflags env) rfm ) - action' = do - GM.withDynFlags (setLogger . setDeferTypedHoles) action - diags <- liftIO $ readIORef diagRef - errs <- liftIO $ readIORef errRef - return (diags,errs) - GM.gcatches action' handlers - -errorHandlers :: (Monad m) => (String -> a) -> (SourceError -> m a) -> [GM.GHandler m a] -errorHandlers ghcErrRes renderSourceError = handlers - where - -- ghc throws GhcException, SourceError, GhcApiError and - -- IOEnvFailure. ghc-mod-core throws GhcModError. - handlers = - [ GM.GHandler $ \(ex :: GM.GhcModError) -> - return $ ghcErrRes (show ex) - , GM.GHandler $ \(ex :: IOEnvFailure) -> - return $ ghcErrRes (show ex) - , GM.GHandler $ \(ex :: GhcApiError) -> - return $ ghcErrRes (show ex) - , GM.GHandler $ \(ex :: SourceError) -> - renderSourceError ex - , GM.GHandler $ \(ex :: GhcException) -> - return $ ghcErrRes $ GM.renderGm $ GM.ghcExceptionDoc ex - , GM.GHandler $ \(ex :: IOError) -> - return $ ghcErrRes (show ex) - -- , GM.GHandler $ \(ex :: GM.SomeException) -> - -- return $ ghcErrRes (show ex) - ] - -setTypecheckedModule :: Uri -> IdeGhcM (IdeResult (Diagnostics, AdditionalErrs)) -setTypecheckedModule uri = - pluginGetFile "setTypecheckedModule: " uri $ \fp -> do - fileMap <- GM.getMMappedFiles - debugm $ "setTypecheckedModule: file mapping state is: " ++ show fileMap - rfm <- GM.mkRevRedirMapFunc - let - ghcErrRes msg = ((Map.empty, [T.pack msg]),Nothing,Nothing) - debugm "setTypecheckedModule: before ghc-mod" - ((diags', errs), mtm, mpm) <- GM.gcatches - (GM.getModulesGhc' (myWrapper rfm) fp) - (errorHandlers ghcErrRes (return . ghcErrRes . show)) - debugm "setTypecheckedModule: after ghc-mod" - - canonUri <- canonicalizeUri uri - let diags = Map.insertWith Set.union canonUri Set.empty diags' - diags2 <- case (mpm,mtm) of - (Just pm, Nothing) -> do - debugm $ "setTypecheckedModule: Did get parsed module for: " ++ show fp - cacheModule fp (Left pm) - debugm "setTypecheckedModule: done" - return diags - - (_, Just tm) -> do - debugm $ "setTypecheckedModule: Did get typechecked module for: " ++ show fp - sess <- fmap GM.gmgsSession . GM.gmGhcSession <$> GM.gmsGet - - -- set the session before we cache the module, so that deferred - -- responses triggered by cacheModule can access it - modifyMTS (\s -> s {ghcSession = sess}) - cacheModule fp (Right tm) - debugm "setTypecheckedModule: done" - return diags - - _ -> do - debugm $ "setTypecheckedModule: Didn't get typechecked or parsed module for: " ++ show fp - debugm $ "setTypecheckedModule: errs: " ++ show errs - - failModule fp - - let sev = Just DsError - range = Range (Position 0 0) (Position 1 0) - msgTxt = T.unlines errs - let d = Diagnostic range sev Nothing (Just "ghcmod") msgTxt Nothing - return $ Map.insertWith Set.union canonUri (Set.singleton d) diags - - return $ IdeResultOk (diags2,errs) - --- --------------------------------------------------------------------- - lintCmd :: CommandFunc Uri T.Text lintCmd = CmdSync lintCmd' diff --git a/src/Haskell/Ide/Engine/Transport/LspStdio.hs b/src/Haskell/Ide/Engine/Transport/LspStdio.hs index d9ca761cc..cbaf6edba 100644 --- a/src/Haskell/Ide/Engine/Transport/LspStdio.hs +++ b/src/Haskell/Ide/Engine/Transport/LspStdio.hs @@ -42,13 +42,13 @@ import Data.Text.Encoding import qualified GhcMod.Monad.Types as GM import qualified GhcModCore as GM import Haskell.Ide.Engine.Config +import qualified Haskell.Ide.Engine.Ghc as HIE import Haskell.Ide.Engine.LSP.CodeActions import Haskell.Ide.Engine.LSP.Reactor import Haskell.Ide.Engine.MonadFunctions import Haskell.Ide.Engine.MonadTypes import qualified Haskell.Ide.Engine.Plugin.ApplyRefact as ApplyRefact import Haskell.Ide.Engine.Plugin.Base -import qualified Haskell.Ide.Engine.Plugin.GhcMod as GhcMod import qualified Haskell.Ide.Engine.Plugin.HaRe as HaRe import qualified Haskell.Ide.Engine.Plugin.Hoogle as Hoogle import Haskell.Ide.Engine.PluginUtils @@ -955,7 +955,7 @@ requestDiagnosticsNormal tn file mVer = do -- get GHC diagnostics and loads the typechecked module into the cache let reqg = GReq tn (Just file) (Just (file,ver)) Nothing callbackg - $ GhcMod.setTypecheckedModule file + $ HIE.setTypecheckedModule file callbackg (pd, errs) = do forM_ errs $ \e -> do reactorSend $ NotShowMessage $ diff --git a/test/unit/GhcModPluginSpec.hs b/test/unit/GhcModPluginSpec.hs index 699e4efb8..e55f0ecf9 100644 --- a/test/unit/GhcModPluginSpec.hs +++ b/test/unit/GhcModPluginSpec.hs @@ -10,6 +10,7 @@ import Data.Monoid #endif import qualified Data.Set as S import qualified Data.Text as T +import Haskell.Ide.Engine.Ghc import Haskell.Ide.Engine.MonadTypes import Haskell.Ide.Engine.Plugin.GhcMod import Haskell.Ide.Engine.PluginUtils diff --git a/test/unit/HaRePluginSpec.hs b/test/unit/HaRePluginSpec.hs index 6a4824355..ec797ce70 100644 --- a/test/unit/HaRePluginSpec.hs +++ b/test/unit/HaRePluginSpec.hs @@ -10,9 +10,9 @@ import Control.Monad.IO.Class import Data.Aeson import qualified Data.Map as M import qualified Data.HashMap.Strict as H +import Haskell.Ide.Engine.Ghc import Haskell.Ide.Engine.MonadTypes import Haskell.Ide.Engine.PluginUtils -import Haskell.Ide.Engine.Plugin.GhcMod import Haskell.Ide.Engine.Plugin.HaRe import Haskell.Ide.Engine.Support.HieExtras import Language.Haskell.LSP.Types ( Location(..) From 0455f9ed88fda2622dcec9b976783c8d7655c539 Mon Sep 17 00:00:00 2001 From: Alan Zimmerman Date: Sun, 21 Apr 2019 21:49:50 +0200 Subject: [PATCH 06/20] Tweaks --- .../Haskell/Ide/Engine/ModuleCache.hs | 5 +++-- hie-plugin-api/Haskell/Ide/Engine/PluginApi.hs | 17 ++++++++++++++--- 2 files changed, 17 insertions(+), 5 deletions(-) diff --git a/hie-plugin-api/Haskell/Ide/Engine/ModuleCache.hs b/hie-plugin-api/Haskell/Ide/Engine/ModuleCache.hs index c5baa0d7a..3d502f3eb 100644 --- a/hie-plugin-api/Haskell/Ide/Engine/ModuleCache.hs +++ b/hie-plugin-api/Haskell/Ide/Engine/ModuleCache.hs @@ -113,7 +113,8 @@ withCachedInfo fp def callback = deferIfNotCached fp go -- If you need custom data, see also 'ifCachedModuleAndData'. -- If you are in IdeDeferM and would like to wait until a cached module is available, -- see also 'withCachedModule'. -ifCachedModule :: (HasGhcModuleCache m, GM.MonadIO m, CacheableModule b) => FilePath -> a -> (b -> CachedInfo -> m a) -> m a +ifCachedModule :: (HasGhcModuleCache m, GM.MonadIO m, CacheableModule b) + => FilePath -> a -> (b -> CachedInfo -> m a) -> m a ifCachedModule fp def callback = do muc <- getUriCache fp let x = do @@ -210,7 +211,7 @@ lookupCachedData fp tm info dat = do -- | Saves a module to the cache and executes any deferred -- responses waiting on that module. -cacheModule :: FilePath -> (Either GHC.ParsedModule GHC.TypecheckedModule) -> IdeGhcM () +cacheModule :: FilePath -> Either GHC.ParsedModule GHC.TypecheckedModule -> IdeGhcM () cacheModule uri modul = do uri' <- liftIO $ canonicalizePath uri rfm <- GM.mkRevRedirMapFunc diff --git a/hie-plugin-api/Haskell/Ide/Engine/PluginApi.hs b/hie-plugin-api/Haskell/Ide/Engine/PluginApi.hs index 75df6d534..2593f39f3 100644 --- a/hie-plugin-api/Haskell/Ide/Engine/PluginApi.hs +++ b/hie-plugin-api/Haskell/Ide/Engine/PluginApi.hs @@ -29,7 +29,15 @@ module Haskell.Ide.Engine.PluginApi , HIE.MonadIde(..) , HIE.iterT , HIE.LiftsToGhc(..) + , HIE.HasGhcModuleCache(..) + -- * Using the HIE module cache etc + , HIE.setTypecheckedModule + , HIE.Diagnostics + , HIE.AdditionalErrs + , LSP.filePathToUri + , HIE.ifCachedModule + , HIE.CachedInfo(..) -- probably remove the next ones , GM.IOish @@ -51,10 +59,13 @@ module Haskell.Ide.Engine.PluginApi import qualified GhcMod.Monad.Newtypes as GM (GmlT(..)) import qualified GhcMod.Monad.Out as GM (GmOut(..)) import qualified GhcMod.Monad.Types as GM (GmEnv(..),IOish,gmlGetSession,gmlSetSession,cradle) +import qualified GhcMod.Options.Options as GM (globalArgSpec) import qualified GhcMod.Target as GM (cabalResolvedComponents) import qualified GhcMod.Types as GM (ModulePath(..),GmModuleGraph(..),GmComponent(..),GmComponentType(..),Cradle(..),MonadIO(..),OutputOpts(..),GmLogLevel(..),OutputStyle(..),LineSeparator(..)) import qualified GhcMod.Utils as GM (mkRevRedirMapFunc) import qualified GhcModCore as GM (Options(..),defaultOptions,getModulesGhc',GhcModT,runGhcModT) -import qualified GhcMod.Options.Options as GM (globalArgSpec) - -import Haskell.Ide.Engine.PluginsIdeMonads as HIE +import qualified Haskell.Ide.Engine.Ghc as HIE +import qualified Haskell.Ide.Engine.GhcModuleCache as HIE (CachedInfo(..),HasGhcModuleCache(..)) +import qualified Haskell.Ide.Engine.ModuleCache as HIE (ifCachedModule) +import qualified Haskell.Ide.Engine.PluginsIdeMonads as HIE +import qualified Language.Haskell.LSP.Types as LSP ( filePathToUri ) From f9137a37d72a5aa5dbebe7471c36ee771cd93e59 Mon Sep 17 00:00:00 2001 From: Alan Zimmerman Date: Sun, 21 Apr 2019 22:14:27 +0200 Subject: [PATCH 07/20] Add missing module --- hie-plugin-api/Haskell/Ide/Engine/Ghc.hs | 207 +++++++++++++++++++++++ 1 file changed, 207 insertions(+) create mode 100644 hie-plugin-api/Haskell/Ide/Engine/Ghc.hs diff --git a/hie-plugin-api/Haskell/Ide/Engine/Ghc.hs b/hie-plugin-api/Haskell/Ide/Engine/Ghc.hs new file mode 100644 index 000000000..8d3eea47f --- /dev/null +++ b/hie-plugin-api/Haskell/Ide/Engine/Ghc.hs @@ -0,0 +1,207 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TupleSections #-} +{-# LANGUAGE TypeFamilies #-} +-- | This module provides the interface to GHC, mainly for loading +-- modules while updating the module cache. + +module Haskell.Ide.Engine.Ghc + ( + setTypecheckedModule + , Diagnostics + , AdditionalErrs + ) where + +import Bag +import Control.Monad.IO.Class +import Data.IORef +import qualified Data.Map.Strict as Map +import qualified Data.Set as Set +import qualified Data.Text as T +import ErrUtils +import qualified GhcMod.DynFlags as GM +import qualified GhcMod.Error as GM +import qualified GhcMod.Gap as GM +import qualified GhcMod.ModuleLoader as GM +import qualified GhcMod.Monad as GM +import qualified GhcMod.Utils as GM +import Haskell.Ide.Engine.MonadFunctions +import Haskell.Ide.Engine.MonadTypes +import Haskell.Ide.Engine.PluginUtils + +import DynFlags +import GHC +import IOEnv as G +import HscTypes +import Outputable (renderWithStyle) + +-- --------------------------------------------------------------------- + +type Diagnostics = Map.Map Uri (Set.Set Diagnostic) +type AdditionalErrs = [T.Text] + +-- --------------------------------------------------------------------- + +lspSev :: Severity -> DiagnosticSeverity +lspSev SevWarning = DsWarning +lspSev SevError = DsError +lspSev SevFatal = DsError +lspSev SevInfo = DsInfo +lspSev _ = DsInfo + +-- --------------------------------------------------------------------- +-- type LogAction = DynFlags -> WarnReason -> Severity -> SrcSpan -> PprStyle -> MsgDoc -> IO () +logDiag :: (FilePath -> FilePath) -> IORef AdditionalErrs -> IORef Diagnostics -> LogAction +logDiag rfm eref dref df _reason sev spn style msg = do + eloc <- srcSpan2Loc rfm spn + let msgTxt = T.pack $ renderWithStyle df msg style + case eloc of + Right (Location uri range) -> do + let update = Map.insertWith Set.union uri l + where l = Set.singleton diag + diag = Diagnostic range (Just $ lspSev sev) Nothing (Just "ghcmod") msgTxt Nothing + modifyIORef' dref update + Left _ -> do + modifyIORef' eref (msgTxt:) + return () + +-- --------------------------------------------------------------------- + +-- unhelpfulSrcSpanErr :: T.Text -> IdeError +-- unhelpfulSrcSpanErr err = +-- IdeError PluginError +-- ("Unhelpful SrcSpan" <> ": \"" <> err <> "\"") +-- Null + +-- --------------------------------------------------------------------- + +srcErrToDiag :: MonadIO m + => DynFlags + -> (FilePath -> FilePath) + -> SourceError -> m (Diagnostics, AdditionalErrs) +srcErrToDiag df rfm se = do + debugm "in srcErrToDiag" + let errMsgs = bagToList $ srcErrorMessages se + processMsg err = do + let sev = Just DsError + unqual = errMsgContext err + st = GM.mkErrStyle' df unqual + msgTxt = T.pack $ renderWithStyle df (pprLocErrMsg err) st + eloc <- srcSpan2Loc rfm $ errMsgSpan err + case eloc of + Right (Location uri range) -> + return $ Right (uri, Diagnostic range sev Nothing (Just "ghcmod") msgTxt Nothing) + Left _ -> return $ Left msgTxt + processMsgs [] = return (Map.empty,[]) + processMsgs (x:xs) = do + res <- processMsg x + (m,es) <- processMsgs xs + case res of + Right (uri, diag) -> + return (Map.insertWith Set.union uri (Set.singleton diag) m, es) + Left e -> return (m, e:es) + processMsgs errMsgs + +-- --------------------------------------------------------------------- + +myWrapper :: GM.IOish m + => (FilePath -> FilePath) + -> GM.GmlT m () + -> GM.GmlT m (Diagnostics, AdditionalErrs) +myWrapper rfm action = do + env <- getSession + diagRef <- liftIO $ newIORef Map.empty + errRef <- liftIO $ newIORef [] + let setLogger df = df { log_action = logDiag rfm errRef diagRef } + setDeferTypedHoles = setGeneralFlag' Opt_DeferTypedHoles + ghcErrRes msg = (Map.empty, [T.pack msg]) + handlers = errorHandlers ghcErrRes (srcErrToDiag (hsc_dflags env) rfm ) + action' = do + GM.withDynFlags (setLogger . setDeferTypedHoles) action + diags <- liftIO $ readIORef diagRef + errs <- liftIO $ readIORef errRef + return (diags,errs) + GM.gcatches action' handlers + +-- --------------------------------------------------------------------- + +errorHandlers :: (Monad m) => (String -> a) -> (SourceError -> m a) -> [GM.GHandler m a] +errorHandlers ghcErrRes renderSourceError = handlers + where + -- ghc throws GhcException, SourceError, GhcApiError and + -- IOEnvFailure. ghc-mod-core throws GhcModError. + handlers = + [ GM.GHandler $ \(ex :: GM.GhcModError) -> + return $ ghcErrRes (show ex) + , GM.GHandler $ \(ex :: IOEnvFailure) -> + return $ ghcErrRes (show ex) + , GM.GHandler $ \(ex :: GhcApiError) -> + return $ ghcErrRes (show ex) + , GM.GHandler $ \(ex :: SourceError) -> + renderSourceError ex + , GM.GHandler $ \(ex :: GhcException) -> + return $ ghcErrRes $ GM.renderGm $ GM.ghcExceptionDoc ex + , GM.GHandler $ \(ex :: IOError) -> + return $ ghcErrRes (show ex) + -- , GM.GHandler $ \(ex :: GM.SomeException) -> + -- return $ ghcErrRes (show ex) + ] + +-- --------------------------------------------------------------------- + +setTypecheckedModule :: Uri -> IdeGhcM (IdeResult (Diagnostics, AdditionalErrs)) +setTypecheckedModule uri = + pluginGetFile "setTypecheckedModule: " uri $ \fp -> do + fileMap <- GM.getMMappedFiles + debugm $ "setTypecheckedModule: file mapping state is: " ++ show fileMap + rfm <- GM.mkRevRedirMapFunc + let + ghcErrRes msg = ((Map.empty, [T.pack msg]),Nothing,Nothing) + debugm "setTypecheckedModule: before ghc-mod" + -- TODO:AZ: loading this one module may/should trigger loads of any + -- other modules which currently have a VFS entry. Need to make + -- sure that their diagnostics are reported, and their module + -- cache entries are updated. + ((diags', errs), mtm, mpm) <- GM.gcatches + (GM.getModulesGhc' (myWrapper rfm) fp) + (errorHandlers ghcErrRes (return . ghcErrRes . show)) + debugm "setTypecheckedModule: after ghc-mod" + + canonUri <- canonicalizeUri uri + let diags = Map.insertWith Set.union canonUri Set.empty diags' + diags2 <- case (mpm,mtm) of + (Just pm, Nothing) -> do + debugm $ "setTypecheckedModule: Did get parsed module for: " ++ show fp + cacheModule fp (Left pm) + debugm "setTypecheckedModule: done" + return diags + + (_, Just tm) -> do + debugm $ "setTypecheckedModule: Did get typechecked module for: " ++ show fp + sess <- fmap GM.gmgsSession . GM.gmGhcSession <$> GM.gmsGet + + -- set the session before we cache the module, so that deferred + -- responses triggered by cacheModule can access it + modifyMTS (\s -> s {ghcSession = sess}) + cacheModule fp (Right tm) + debugm "setTypecheckedModule: done" + return diags + + _ -> do + debugm $ "setTypecheckedModule: Didn't get typechecked or parsed module for: " ++ show fp + debugm $ "setTypecheckedModule: errs: " ++ show errs + + failModule fp + + let sev = Just DsError + range = Range (Position 0 0) (Position 1 0) + msgTxt = T.unlines errs + let d = Diagnostic range sev Nothing (Just "ghcmod") msgTxt Nothing + return $ Map.insertWith Set.union canonUri (Set.singleton d) diags + + return $ IdeResultOk (diags2,errs) + +-- --------------------------------------------------------------------- From e47d1dc60b1fc878acfd6cc607af1729d4e5bae8 Mon Sep 17 00:00:00 2001 From: Alan Zimmerman Date: Mon, 22 Apr 2019 10:35:18 +0200 Subject: [PATCH 08/20] WIP, includes list of things actually used by HaRe currently --- .../Haskell/Ide/Engine/PluginApi.hs | 32 +++++++++++++++++++ 1 file changed, 32 insertions(+) diff --git a/hie-plugin-api/Haskell/Ide/Engine/PluginApi.hs b/hie-plugin-api/Haskell/Ide/Engine/PluginApi.hs index 2593f39f3..887cfc4c3 100644 --- a/hie-plugin-api/Haskell/Ide/Engine/PluginApi.hs +++ b/hie-plugin-api/Haskell/Ide/Engine/PluginApi.hs @@ -2,6 +2,37 @@ -- integrated into HIE can use, so that they can make use of the -- shared BIOS features. +{- +CachedInfo(..) +Cradle(..) +GhcModT +GmComponent(..) +GmComponentType(..) +GmModuleGraph(..) +GmModuleGraph(..) +GmlT(..) +HasGhcModuleCache(..) +IOish +IdeGhcM +IdeM) +ModulePath(..) +ModulePath(..) +MonadIO(..) +Options(..) +Options(..) +cabalResolvedComponents +cradle +filePathToUri +getModulesGhc' +gmlGetSession +gmlSetSession +ifCachedModule +mkRevRedirMapFunc +runIdeGhcMBare +setTypecheckedModule +-} + + module Haskell.Ide.Engine.PluginApi ( -- ** Re-exported from ghc-mod @@ -38,6 +69,7 @@ module Haskell.Ide.Engine.PluginApi , LSP.filePathToUri , HIE.ifCachedModule , HIE.CachedInfo(..) + -- probably remove the next ones , GM.IOish From e1da17d652410ae0fb8a21de701d67df919f1661 Mon Sep 17 00:00:00 2001 From: Alan Zimmerman Date: Mon, 22 Apr 2019 21:54:42 +0200 Subject: [PATCH 09/20] More narrowing of the plugin api - Add GhcMonad instance to IdeGhcM - Move cabalModuleGraphs into hie-plugin-api - No longer use ghc-mod-core MonadIO. It was a workaround for a problem with GHC from around 7.8 or so, no longer neede. --- hie-plugin-api/Haskell/Ide/Engine/Ghc.hs | 19 +++++++ .../Haskell/Ide/Engine/ModuleCache.hs | 4 +- .../Haskell/Ide/Engine/PluginApi.hs | 57 ++++++------------- .../Haskell/Ide/Engine/PluginsIdeMonads.hs | 13 +++++ 4 files changed, 50 insertions(+), 43 deletions(-) diff --git a/hie-plugin-api/Haskell/Ide/Engine/Ghc.hs b/hie-plugin-api/Haskell/Ide/Engine/Ghc.hs index 8d3eea47f..8486b6cad 100644 --- a/hie-plugin-api/Haskell/Ide/Engine/Ghc.hs +++ b/hie-plugin-api/Haskell/Ide/Engine/Ghc.hs @@ -13,6 +13,7 @@ module Haskell.Ide.Engine.Ghc setTypecheckedModule , Diagnostics , AdditionalErrs + , cabalModuleGraphs ) where import Bag @@ -27,6 +28,8 @@ import qualified GhcMod.Error as GM import qualified GhcMod.Gap as GM import qualified GhcMod.ModuleLoader as GM import qualified GhcMod.Monad as GM +import qualified GhcMod.Target as GM +import qualified GhcMod.Types as GM import qualified GhcMod.Utils as GM import Haskell.Ide.Engine.MonadFunctions import Haskell.Ide.Engine.MonadTypes @@ -205,3 +208,19 @@ setTypecheckedModule uri = return $ IdeResultOk (diags2,errs) -- --------------------------------------------------------------------- + +cabalModuleGraphs :: IdeGhcM [GM.GmModuleGraph] +cabalModuleGraphs = doCabalModuleGraphs + where + doCabalModuleGraphs :: (GM.IOish m) => GM.GhcModT m [GM.GmModuleGraph] + doCabalModuleGraphs = do + crdl <- GM.cradle + case GM.cradleCabalFile crdl of + Just _ -> do + mcs <- GM.cabalResolvedComponents + let graph = map GM.gmcHomeModuleGraph $ Map.elems mcs + return graph + Nothing -> return [] + + +-- --------------------------------------------------------------------- diff --git a/hie-plugin-api/Haskell/Ide/Engine/ModuleCache.hs b/hie-plugin-api/Haskell/Ide/Engine/ModuleCache.hs index 3d502f3eb..a9fc1f206 100644 --- a/hie-plugin-api/Haskell/Ide/Engine/ModuleCache.hs +++ b/hie-plugin-api/Haskell/Ide/Engine/ModuleCache.hs @@ -113,7 +113,7 @@ withCachedInfo fp def callback = deferIfNotCached fp go -- If you need custom data, see also 'ifCachedModuleAndData'. -- If you are in IdeDeferM and would like to wait until a cached module is available, -- see also 'withCachedModule'. -ifCachedModule :: (HasGhcModuleCache m, GM.MonadIO m, CacheableModule b) +ifCachedModule :: (HasGhcModuleCache m, MonadIO m, CacheableModule b) => FilePath -> a -> (b -> CachedInfo -> m a) -> m a ifCachedModule fp def callback = do muc <- getUriCache fp @@ -177,7 +177,7 @@ withCachedModuleAndData fp def callback = deferIfNotCached fp go go (UriCacheSuccess (UriCache _ _ Nothing _)) = wrap (Defer fp go) go UriCacheFailed = return def -getUriCache :: (HasGhcModuleCache m, GM.MonadIO m) => FilePath -> m (Maybe UriCacheResult) +getUriCache :: (HasGhcModuleCache m, MonadIO m) => FilePath -> m (Maybe UriCacheResult) getUriCache fp = do uri' <- liftIO $ canonicalizePath fp fmap (Map.lookup uri' . uriCaches) getModuleCache diff --git a/hie-plugin-api/Haskell/Ide/Engine/PluginApi.hs b/hie-plugin-api/Haskell/Ide/Engine/PluginApi.hs index 887cfc4c3..f2ae6228a 100644 --- a/hie-plugin-api/Haskell/Ide/Engine/PluginApi.hs +++ b/hie-plugin-api/Haskell/Ide/Engine/PluginApi.hs @@ -3,31 +3,24 @@ -- shared BIOS features. {- -CachedInfo(..) -Cradle(..) -GhcModT +-- Stuff used in HaRe currently +Options(..) +defaultOptions +mkRevRedirMapFunc +GmModuleGraph(..) +ModulePath(..) GmComponent(..) GmComponentType(..) -GmModuleGraph(..) -GmModuleGraph(..) -GmlT(..) + +CachedInfo(..) HasGhcModuleCache(..) -IOish IdeGhcM -IdeM) -ModulePath(..) -ModulePath(..) -MonadIO(..) -Options(..) -Options(..) -cabalResolvedComponents -cradle + +cabalModuleGraphs filePathToUri -getModulesGhc' -gmlGetSession -gmlSetSession + +MonadIO(..) ifCachedModule -mkRevRedirMapFunc runIdeGhcMBare setTypecheckedModule -} @@ -38,16 +31,11 @@ module Haskell.Ide.Engine.PluginApi -- ** Re-exported from ghc-mod GM.Options(..) , GM.defaultOptions - , GM.getModulesGhc' , GM.mkRevRedirMapFunc - , GM.cradle - , GM.Cradle(..) - , GM.GmModuleGraph(..) , GM.ModulePath(..) , GM.GmComponent(..) , GM.GmComponentType(..) - , GM.cabalResolvedComponents -- * IDE monads , HIE.IdeState(..) @@ -61,6 +49,7 @@ module Haskell.Ide.Engine.PluginApi , HIE.iterT , HIE.LiftsToGhc(..) , HIE.HasGhcModuleCache(..) + , HIE.cabalModuleGraphs -- * Using the HIE module cache etc , HIE.setTypecheckedModule @@ -70,17 +59,7 @@ module Haskell.Ide.Engine.PluginApi , HIE.ifCachedModule , HIE.CachedInfo(..) - -- probably remove the next ones - - , GM.IOish - , GM.MonadIO(..) - , GM.GmOut(..) - , GM.GhcModT - , GM.runGhcModT - , GM.GmlT(..) - , GM.GmEnv(..) - , GM.gmlGetSession - , GM.gmlSetSession + -- * used for tests in HaRe , GM.globalArgSpec , GM.OutputOpts(..) , GM.GmLogLevel(..) @@ -88,14 +67,10 @@ module Haskell.Ide.Engine.PluginApi , GM.LineSeparator(..) ) where -import qualified GhcMod.Monad.Newtypes as GM (GmlT(..)) -import qualified GhcMod.Monad.Out as GM (GmOut(..)) -import qualified GhcMod.Monad.Types as GM (GmEnv(..),IOish,gmlGetSession,gmlSetSession,cradle) import qualified GhcMod.Options.Options as GM (globalArgSpec) -import qualified GhcMod.Target as GM (cabalResolvedComponents) -import qualified GhcMod.Types as GM (ModulePath(..),GmModuleGraph(..),GmComponent(..),GmComponentType(..),Cradle(..),MonadIO(..),OutputOpts(..),GmLogLevel(..),OutputStyle(..),LineSeparator(..)) +import qualified GhcMod.Types as GM (ModulePath(..),GmModuleGraph(..),GmComponent(..),GmComponentType(..),OutputOpts(..),GmLogLevel(..),OutputStyle(..),LineSeparator(..)) import qualified GhcMod.Utils as GM (mkRevRedirMapFunc) -import qualified GhcModCore as GM (Options(..),defaultOptions,getModulesGhc',GhcModT,runGhcModT) +import qualified GhcModCore as GM (Options(..),defaultOptions) import qualified Haskell.Ide.Engine.Ghc as HIE import qualified Haskell.Ide.Engine.GhcModuleCache as HIE (CachedInfo(..),HasGhcModuleCache(..)) import qualified Haskell.Ide.Engine.ModuleCache as HIE (ifCachedModule) diff --git a/hie-plugin-api/Haskell/Ide/Engine/PluginsIdeMonads.hs b/hie-plugin-api/Haskell/Ide/Engine/PluginsIdeMonads.hs index 9698a7120..686bab5fd 100644 --- a/hie-plugin-api/Haskell/Ide/Engine/PluginsIdeMonads.hs +++ b/hie-plugin-api/Haskell/Ide/Engine/PluginsIdeMonads.hs @@ -103,6 +103,10 @@ import qualified GhcMod.Monad as GM import qualified GhcMod.Types as GM import GHC.Generics import GHC ( HscEnv ) +import qualified DynFlags as GHC +import qualified GHC as GHC +import qualified HscTypes as GHC + import Haskell.Ide.Engine.Compat import Haskell.Ide.Engine.Config @@ -452,6 +456,15 @@ instance HasGhcModuleCache IdeM where tvar <- lift ask liftIO $ atomically $ modifyTVar' tvar (\st -> st { moduleCache = mc }) +-- --------------------------------------------------------------------- + +instance GHC.HasDynFlags IdeGhcM where + getDynFlags = GHC.hsc_dflags <$> GHC.getSession + +instance GHC.GhcMonad IdeGhcM where + getSession = GM.unGmlT GM.gmlGetSession + setSession env = GM.unGmlT (GM.gmlSetSession env) + -- --------------------------------------------------------------------- -- Results -- --------------------------------------------------------------------- From e1133226cb409b81b391699e28eb53adfa20f5d9 Mon Sep 17 00:00:00 2001 From: Alan Zimmerman Date: Sat, 27 Apr 2019 20:24:37 +0200 Subject: [PATCH 10/20] Start using ghc-project-types for the plugin API --- hie-plugin-api/Haskell/Ide/Engine/PluginApi.hs | 12 +++++++----- hie-plugin-api/hie-plugin-api.cabal | 1 + stack.yaml | 1 + submodules/ghc-mod | 2 +- 4 files changed, 10 insertions(+), 6 deletions(-) diff --git a/hie-plugin-api/Haskell/Ide/Engine/PluginApi.hs b/hie-plugin-api/Haskell/Ide/Engine/PluginApi.hs index f2ae6228a..b53a3d2ec 100644 --- a/hie-plugin-api/Haskell/Ide/Engine/PluginApi.hs +++ b/hie-plugin-api/Haskell/Ide/Engine/PluginApi.hs @@ -32,10 +32,10 @@ module Haskell.Ide.Engine.PluginApi GM.Options(..) , GM.defaultOptions , GM.mkRevRedirMapFunc - , GM.GmModuleGraph(..) - , GM.ModulePath(..) - , GM.GmComponent(..) - , GM.GmComponentType(..) + , GP.GmModuleGraph(..) + , GP.ModulePath(..) + , GP.GmComponent(..) + , GP.GmComponentType(..) -- * IDE monads , HIE.IdeState(..) @@ -68,9 +68,11 @@ module Haskell.Ide.Engine.PluginApi ) where import qualified GhcMod.Options.Options as GM (globalArgSpec) -import qualified GhcMod.Types as GM (ModulePath(..),GmModuleGraph(..),GmComponent(..),GmComponentType(..),OutputOpts(..),GmLogLevel(..),OutputStyle(..),LineSeparator(..)) +-- import qualified GhcMod.Types as GM (ModulePath(..),GmModuleGraph(..),GmComponent(..),GmComponentType(..),OutputOpts(..),GmLogLevel(..),OutputStyle(..),LineSeparator(..)) +import qualified GhcMod.Types as GM (OutputOpts(..),GmLogLevel(..),OutputStyle(..),LineSeparator(..)) import qualified GhcMod.Utils as GM (mkRevRedirMapFunc) import qualified GhcModCore as GM (Options(..),defaultOptions) +import qualified GhcProject.Types as GP import qualified Haskell.Ide.Engine.Ghc as HIE import qualified Haskell.Ide.Engine.GhcModuleCache as HIE (CachedInfo(..),HasGhcModuleCache(..)) import qualified Haskell.Ide.Engine.ModuleCache as HIE (ifCachedModule) diff --git a/hie-plugin-api/hie-plugin-api.cabal b/hie-plugin-api/hie-plugin-api.cabal index 252abdf94..700c1ea57 100644 --- a/hie-plugin-api/hie-plugin-api.cabal +++ b/hie-plugin-api/hie-plugin-api.cabal @@ -43,6 +43,7 @@ library , free , ghc , ghc-mod-core >= 5.9.0.0 + , ghc-project-types >= 5.9.0.0 , haskell-lsp == 0.9.* , hslogger , monad-control diff --git a/stack.yaml b/stack.yaml index def0c1986..1a648fe02 100644 --- a/stack.yaml +++ b/stack.yaml @@ -10,6 +10,7 @@ extra-deps: - ./submodules/floskell - ./submodules/ghc-mod - ./submodules/ghc-mod/core +- ./submodules/ghc-mod/ghc-project-types - ansi-terminal-0.8.2 - butcher-1.3.2.1 diff --git a/submodules/ghc-mod b/submodules/ghc-mod index b20536757..17403cede 160000 --- a/submodules/ghc-mod +++ b/submodules/ghc-mod @@ -1 +1 @@ -Subproject commit b20536757f34769c6fe4478f13b71a55c9ae582e +Subproject commit 17403cedeaa85e5d78d548afc95e1467cc3f5720 From fbd686086d2100cf6dc0d05142eed86ae937377e Mon Sep 17 00:00:00 2001 From: Alan Zimmerman Date: Sun, 28 Apr 2019 00:11:19 +0200 Subject: [PATCH 11/20] Only ghc-mod Options and defaultOptions left to decouple --- hie-plugin-api/Haskell/Ide/Engine/Ghc.hs | 8 ++++++++ hie-plugin-api/Haskell/Ide/Engine/PluginApi.hs | 4 ++-- hie-plugin-api/Haskell/Ide/Engine/PluginUtils.hs | 4 +++- hie-plugin-api/Haskell/Ide/Engine/PluginsIdeMonads.hs | 4 ++-- src/Haskell/Ide/Engine/Support/HieExtras.hs | 10 +++++----- 5 files changed, 20 insertions(+), 10 deletions(-) diff --git a/hie-plugin-api/Haskell/Ide/Engine/Ghc.hs b/hie-plugin-api/Haskell/Ide/Engine/Ghc.hs index 8486b6cad..7c2c5eccf 100644 --- a/hie-plugin-api/Haskell/Ide/Engine/Ghc.hs +++ b/hie-plugin-api/Haskell/Ide/Engine/Ghc.hs @@ -14,6 +14,7 @@ module Haskell.Ide.Engine.Ghc , Diagnostics , AdditionalErrs , cabalModuleGraphs + , makeRevRedirMapFunc ) where import Bag @@ -222,5 +223,12 @@ cabalModuleGraphs = doCabalModuleGraphs return graph Nothing -> return [] +-- --------------------------------------------------------------------- + +makeRevRedirMapFunc :: IdeGhcM (FilePath -> FilePath) +makeRevRedirMapFunc = make + where + make :: (GM.IOish m) => GM.GhcModT m (FilePath -> FilePath) + make = GM.mkRevRedirMapFunc -- --------------------------------------------------------------------- diff --git a/hie-plugin-api/Haskell/Ide/Engine/PluginApi.hs b/hie-plugin-api/Haskell/Ide/Engine/PluginApi.hs index b53a3d2ec..773fec8ea 100644 --- a/hie-plugin-api/Haskell/Ide/Engine/PluginApi.hs +++ b/hie-plugin-api/Haskell/Ide/Engine/PluginApi.hs @@ -6,7 +6,6 @@ -- Stuff used in HaRe currently Options(..) defaultOptions -mkRevRedirMapFunc GmModuleGraph(..) ModulePath(..) GmComponent(..) @@ -18,6 +17,7 @@ IdeGhcM cabalModuleGraphs filePathToUri +makeRevRedirMapFunc MonadIO(..) ifCachedModule @@ -31,7 +31,6 @@ module Haskell.Ide.Engine.PluginApi -- ** Re-exported from ghc-mod GM.Options(..) , GM.defaultOptions - , GM.mkRevRedirMapFunc , GP.GmModuleGraph(..) , GP.ModulePath(..) , GP.GmComponent(..) @@ -50,6 +49,7 @@ module Haskell.Ide.Engine.PluginApi , HIE.LiftsToGhc(..) , HIE.HasGhcModuleCache(..) , HIE.cabalModuleGraphs + , HIE.makeRevRedirMapFunc -- * Using the HIE module cache etc , HIE.setTypecheckedModule diff --git a/hie-plugin-api/Haskell/Ide/Engine/PluginUtils.hs b/hie-plugin-api/Haskell/Ide/Engine/PluginUtils.hs index 528c3a592..c5b61ed45 100644 --- a/hie-plugin-api/Haskell/Ide/Engine/PluginUtils.hs +++ b/hie-plugin-api/Haskell/Ide/Engine/PluginUtils.hs @@ -92,6 +92,8 @@ srcSpan2Range :: SrcSpan -> Either T.Text Range srcSpan2Range spn = realSrcSpan2Range <$> getRealSrcSpan spn + + reverseMapFile :: MonadIO m => (FilePath -> FilePath) -> FilePath -> m FilePath reverseMapFile rfm fp = do fp' <- liftIO $ canonicalizePath fp @@ -288,4 +290,4 @@ rangeLinesFromVfs (VirtualFile _ yitext) (Range (Position lf _cf) (Position lt _ where (_ ,s1) = Yi.splitAtLine lf yitext (s2, _) = Yi.splitAtLine (lt - lf) s1 - r = Yi.toText s2 \ No newline at end of file + r = Yi.toText s2 diff --git a/hie-plugin-api/Haskell/Ide/Engine/PluginsIdeMonads.hs b/hie-plugin-api/Haskell/Ide/Engine/PluginsIdeMonads.hs index 686bab5fd..bc5a00b40 100644 --- a/hie-plugin-api/Haskell/Ide/Engine/PluginsIdeMonads.hs +++ b/hie-plugin-api/Haskell/Ide/Engine/PluginsIdeMonads.hs @@ -219,8 +219,8 @@ data FormattingType = FormatDocument -- | Formats the given Text associated with the given Uri. -- Should, but might not, honor the provided formatting options (e.g. Floskell does not). -- A formatting type can be given to either format the whole document or only a Range. --- --- Text to format, may or may not, originate from the associated Uri. +-- +-- Text to format, may or may not, originate from the associated Uri. -- E.g. it is ok, to modify the text and then reformat it through this API. -- -- The Uri is mainly used to discover formatting configurations in the file's path. diff --git a/src/Haskell/Ide/Engine/Support/HieExtras.hs b/src/Haskell/Ide/Engine/Support/HieExtras.hs index f890ba905..68f689749 100644 --- a/src/Haskell/Ide/Engine/Support/HieExtras.hs +++ b/src/Haskell/Ide/Engine/Support/HieExtras.hs @@ -482,7 +482,7 @@ getSymbolsAtPoint :: Position -> CachedInfo -> [(Range,Name)] getSymbolsAtPoint pos info = maybe [] (`getArtifactsAtPos` locMap info) $ newPosToOld info pos -- |Get a symbol from the given location map at the given location. --- Retrieves the name and range of the symbol at the given location +-- Retrieves the name and range of the symbol at the given location -- from the cached location map. symbolFromTypecheckedModule :: LocMap @@ -563,8 +563,8 @@ findTypeDef uri pos = pluginGetFile "findTypeDef: " uri $ \file -> -- | Get SrcSpan of the name at the given position. -- If the old position is Nothing, e.g. there is no cached info about it, -- Nothing is returned. - -- - -- Otherwise, searches for the Type of the given position + -- + -- Otherwise, searches for the Type of the given position -- and retrieves its SrcSpan. getTypeSrcSpanFromPosition :: Maybe Position -> ExceptT () IdeDeferM SrcSpan @@ -647,7 +647,7 @@ gotoModule rfm mn = do case fr of Found (ModLocation (Just src) _ _) _ -> do fp <- reverseMapFile rfm src - + let r = Range (Position 0 0) (Position 0 0) loc = Location (filePathToUri fp) r return (IdeResultOk [loc]) @@ -805,7 +805,7 @@ prefixes = -- --------------------------------------------------------------------- getFormattingPlugin :: Config -> IdePlugins -> Maybe (PluginDescriptor, FormattingProvider) -getFormattingPlugin config plugins = do +getFormattingPlugin config plugins = do let providerName = formattingProvider config fmtPlugin <- Map.lookup providerName (ipMap plugins) fmtProvider <- pluginFormattingProvider fmtPlugin From 1d4a52c123a3f619135ae39c636294342f0cf63d Mon Sep 17 00:00:00 2001 From: Alan Zimmerman Date: Sun, 28 Apr 2019 14:45:01 +0200 Subject: [PATCH 12/20] Use hie data type BiosOptions instead of ghc-mod Options --- app/MainHie.hs | 12 ++-- .../Haskell/Ide/Engine/PluginApi.hs | 23 +++---- .../Haskell/Ide/Engine/PluginsIdeMonads.hs | 63 ++++++++++++++++--- src/Haskell/Ide/Engine/Plugin/GhcMod.hs | 2 +- src/Haskell/Ide/Engine/Scheduler.hs | 12 ++-- test/utils/TestUtils.hs | 20 +++--- 6 files changed, 82 insertions(+), 50 deletions(-) diff --git a/app/MainHie.hs b/app/MainHie.hs index 3335fa29e..9976bd89d 100644 --- a/app/MainHie.hs +++ b/app/MainHie.hs @@ -5,7 +5,6 @@ module Main where import Control.Monad import Data.Monoid ((<>)) import Data.Version (showVersion) -import qualified GhcMod.Types as GM import Haskell.Ide.Engine.MonadFunctions import Haskell.Ide.Engine.MonadTypes import Haskell.Ide.Engine.Options @@ -121,13 +120,12 @@ run opts = do d <- getCurrentDirectory logm $ "Current directory:" ++ d - let vomitOptions = GM.defaultOptions { GM.optOutput = oo { GM.ooptLogLevel = GM.GmVomit}} - oo = GM.optOutput GM.defaultOptions - let defaultOpts = if optGhcModVomit opts then vomitOptions else GM.defaultOptions + let vomitOptions = defaultOptions { boLogging = BlVomit} + let defaultOpts = if optGhcModVomit opts then vomitOptions else defaultOptions -- Running HIE on projects with -Werror breaks most of the features since all warnings -- will be treated with the same severity of type errors. In order to offer a more useful -- experience, we make sure warnings are always reported as warnings by setting -Wwarn - ghcModOptions = defaultOpts { GM.optGhcUserOptions = ["-Wwarn"] } + biosOptions = defaultOpts { boGhcUserOptions = ["-Wwarn"] } when (optGhcModVomit opts) $ logm "Enabling --vomit for ghc-mod. Output will be on stderr" @@ -139,8 +137,8 @@ run opts = do -- launch the dispatcher. if optJson opts then do - scheduler <- newScheduler plugins' ghcModOptions + scheduler <- newScheduler plugins' biosOptions jsonStdioTransport scheduler else do - scheduler <- newScheduler plugins' ghcModOptions + scheduler <- newScheduler plugins' biosOptions lspStdioTransport scheduler origDir plugins' (optCaptureFile opts) diff --git a/hie-plugin-api/Haskell/Ide/Engine/PluginApi.hs b/hie-plugin-api/Haskell/Ide/Engine/PluginApi.hs index 773fec8ea..be98cd114 100644 --- a/hie-plugin-api/Haskell/Ide/Engine/PluginApi.hs +++ b/hie-plugin-api/Haskell/Ide/Engine/PluginApi.hs @@ -28,10 +28,8 @@ setTypecheckedModule module Haskell.Ide.Engine.PluginApi ( - -- ** Re-exported from ghc-mod - GM.Options(..) - , GM.defaultOptions - , GP.GmModuleGraph(..) + -- ** Re-exported from ghc-mod via ghc-project-types + GP.GmModuleGraph(..) , GP.ModulePath(..) , GP.GmComponent(..) , GP.GmComponentType(..) @@ -60,21 +58,14 @@ module Haskell.Ide.Engine.PluginApi , HIE.CachedInfo(..) -- * used for tests in HaRe - , GM.globalArgSpec - , GM.OutputOpts(..) - , GM.GmLogLevel(..) - , GM.OutputStyle(..) - , GM.LineSeparator(..) + , HIE.BiosLogLevel(..) + , HIE.BiosOptions(..) + , HIE.defaultOptions ) where -import qualified GhcMod.Options.Options as GM (globalArgSpec) --- import qualified GhcMod.Types as GM (ModulePath(..),GmModuleGraph(..),GmComponent(..),GmComponentType(..),OutputOpts(..),GmLogLevel(..),OutputStyle(..),LineSeparator(..)) -import qualified GhcMod.Types as GM (OutputOpts(..),GmLogLevel(..),OutputStyle(..),LineSeparator(..)) -import qualified GhcMod.Utils as GM (mkRevRedirMapFunc) -import qualified GhcModCore as GM (Options(..),defaultOptions) -import qualified GhcProject.Types as GP +import qualified GhcProject.Types as GP import qualified Haskell.Ide.Engine.Ghc as HIE -import qualified Haskell.Ide.Engine.GhcModuleCache as HIE (CachedInfo(..),HasGhcModuleCache(..)) +import qualified Haskell.Ide.Engine.GhcModuleCache as HIE (CachedInfo(..),HasGhcModuleCache(..)) import qualified Haskell.Ide.Engine.ModuleCache as HIE (ifCachedModule) import qualified Haskell.Ide.Engine.PluginsIdeMonads as HIE import qualified Language.Haskell.LSP.Types as LSP ( filePathToUri ) diff --git a/hie-plugin-api/Haskell/Ide/Engine/PluginsIdeMonads.hs b/hie-plugin-api/Haskell/Ide/Engine/PluginsIdeMonads.hs index bc5a00b40..5b3f7d75a 100644 --- a/hie-plugin-api/Haskell/Ide/Engine/PluginsIdeMonads.hs +++ b/hie-plugin-api/Haskell/Ide/Engine/PluginsIdeMonads.hs @@ -75,6 +75,11 @@ module Haskell.Ide.Engine.PluginsIdeMonads , PublishDiagnosticsParams(..) , List(..) , FormattingOptions(..) + -- * Options + , BiosLogLevel(..) + , BiosOptions(..) + , defaultOptions + , mkGhcModOptions ) where @@ -84,7 +89,7 @@ import Control.Monad.IO.Class import Control.Monad.Reader import Control.Monad.Trans.Free -import Data.Aeson +import Data.Aeson hiding (defaultOptions) import qualified Data.ConstrainedDynamic as CD import Data.Default import qualified Data.List as List @@ -107,11 +112,10 @@ import qualified DynFlags as GHC import qualified GHC as GHC import qualified HscTypes as GHC - import Haskell.Ide.Engine.Compat import Haskell.Ide.Engine.Config -import Haskell.Ide.Engine.MultiThreadState import Haskell.Ide.Engine.GhcModuleCache +import Haskell.Ide.Engine.MultiThreadState import qualified Language.Haskell.LSP.Core as Core import Language.Haskell.LSP.Types.Capabilities @@ -319,23 +323,24 @@ getDiagnosticProvidersConfig c = Map.fromList [("applyrefact",hlintOn c) type IdeGhcM = GM.GhcModT IdeM -- | Run an IdeGhcM with Cradle found from the current directory -runIdeGhcM :: GM.Options -> IdePlugins -> Maybe (Core.LspFuncs Config) -> TVar IdeState -> IdeGhcM a -> IO a -runIdeGhcM ghcModOptions plugins mlf stateVar f = do +runIdeGhcM :: BiosOptions -> IdePlugins -> Maybe (Core.LspFuncs Config) -> TVar IdeState -> IdeGhcM a -> IO a +runIdeGhcM biosOptions plugins mlf stateVar f = do env <- IdeEnv <$> pure mlf <*> getProcessID <*> pure plugins + let ghcModOptions = mkGhcModOptions biosOptions (eres, _) <- flip runReaderT stateVar $ flip runReaderT env $ GM.runGhcModT ghcModOptions f case eres of Left err -> liftIO $ throwIO err Right res -> return res -- | Run an IdeGhcM in an external context (e.g. HaRe), with no plugins or LSP functions -runIdeGhcMBare :: GM.Options -> IdeGhcM a -> IO a -runIdeGhcMBare ghcModOptions f = do +runIdeGhcMBare :: BiosOptions -> IdeGhcM a -> IO a +runIdeGhcMBare biosOptions f = do let plugins = IdePlugins Map.empty mlf = Nothing initialState = IdeState emptyModuleCache Map.empty Map.empty Nothing stateVar <- newTVarIO initialState - runIdeGhcM ghcModOptions plugins mlf stateVar f + runIdeGhcM biosOptions plugins mlf stateVar f -- | A computation that is deferred until the module is cached. -- Note that the module may not typecheck, in which case 'UriCacheFailed' is passed @@ -536,3 +541,45 @@ data IdeError = IdeError instance ToJSON IdeError instance FromJSON IdeError + +-- --------------------------------------------------------------------- +-- Probably need to move this some time, but hitting import cycle issues + +data BiosLogLevel = + BlError + | BlWarning + | BlInfo + | BlDebug + | BlVomit + deriving (Eq, Ord, Enum, Bounded, Show, Read) + +data BiosOptions = BiosOptions { + boGhcUserOptions :: [String] + , boLogging :: BiosLogLevel + } deriving Show + +defaultOptions :: BiosOptions +defaultOptions = BiosOptions { + boGhcUserOptions = [] + , boLogging = BlWarning + } + +fmBiosLog :: BiosLogLevel -> GM.GmLogLevel +fmBiosLog bl = case bl of + BlError -> GM.GmError + BlWarning -> GM.GmWarning + BlInfo -> GM.GmInfo + BlDebug -> GM.GmDebug + BlVomit -> GM.GmVomit + +-- --------------------------------------------------------------------- + +-- | Apply BiosOptions to default ghc-mod Options +mkGhcModOptions :: BiosOptions -> GM.Options +mkGhcModOptions bo = GM.defaultOptions + { + GM.optGhcUserOptions = boGhcUserOptions bo + , GM.optOutput = (GM.optOutput GM.defaultOptions) { GM.ooptLogLevel = fmBiosLog (boLogging bo) } + } + +-- --------------------------------------------------------------------- diff --git a/src/Haskell/Ide/Engine/Plugin/GhcMod.hs b/src/Haskell/Ide/Engine/Plugin/GhcMod.hs index 13f5d0c2a..e1f10aa83 100644 --- a/src/Haskell/Ide/Engine/Plugin/GhcMod.hs +++ b/src/Haskell/Ide/Engine/Plugin/GhcMod.hs @@ -41,7 +41,7 @@ import qualified GhcMod.Gap as GM import qualified GhcMod.SrcUtils as GM import qualified GhcMod.Types as GM import Haskell.Ide.Engine.Ghc -import Haskell.Ide.Engine.MonadTypes +import Haskell.Ide.Engine.MonadTypes hiding (defaultOptions) import Haskell.Ide.Engine.PluginUtils import qualified Haskell.Ide.Engine.Support.HieExtras as Hie import Haskell.Ide.Engine.ArtifactMap diff --git a/src/Haskell/Ide/Engine/Scheduler.hs b/src/Haskell/Ide/Engine/Scheduler.hs index b30b9dad4..cc34e8493 100644 --- a/src/Haskell/Ide/Engine/Scheduler.hs +++ b/src/Haskell/Ide/Engine/Scheduler.hs @@ -60,8 +60,8 @@ data Scheduler m = Scheduler { plugins :: IdePlugins -- ^ The list of plugins that will be used for responding to requests - , ghcModOptions :: GM.Options - -- ^ Options for the ghc-mod session. Since we only keep a single ghc-mod session + , biosOptions :: BiosOptions + -- ^ Options for the bios session. Since we only keep a single bios session -- at a time, this cannot be changed a runtime. , requestsToCancel :: STM.TVar (Set.Set J.LspId) @@ -99,10 +99,10 @@ class HasScheduler a m where newScheduler :: IdePlugins -- ^ The list of plugins that will be used for responding to requests - -> GM.Options + -> BiosOptions -- ^ Options for the ghc-mod session. Since we only keep a single ghc-mod session -> IO (Scheduler m) -newScheduler plugins ghcModOptions = do +newScheduler plugins biosOpts = do cancelTVar <- STM.atomically $ STM.newTVar Set.empty wipTVar <- STM.atomically $ STM.newTVar Set.empty versionTVar <- STM.atomically $ STM.newTVar Map.empty @@ -110,7 +110,7 @@ newScheduler plugins ghcModOptions = do ghcChan <- Channel.newChan return $ Scheduler { plugins = plugins - , ghcModOptions = ghcModOptions + , biosOptions = biosOpts , requestsToCancel = cancelTVar , requestsInProgress = wipTVar , documentVersions = versionTVar @@ -152,7 +152,7 @@ runScheduler Scheduler {..} errorHandler callbackHandler mlf = do stateVar <- STM.newTVarIO initialState - let runGhcDisp = runIdeGhcM ghcModOptions plugins mlf stateVar $ + let runGhcDisp = runIdeGhcM biosOptions plugins mlf stateVar $ ghcDispatcher dEnv errorHandler callbackHandler ghcChanOut runIdeDisp = runIdeM plugins mlf stateVar $ ideDispatcher dEnv errorHandler callbackHandler ideChanOut diff --git a/test/utils/TestUtils.hs b/test/utils/TestUtils.hs index b20009283..8828df5b5 100644 --- a/test/utils/TestUtils.hs +++ b/test/utils/TestUtils.hs @@ -25,8 +25,8 @@ import Data.Typeable import Data.Yaml import qualified Data.Map as Map import Data.Maybe -import qualified GhcMod.Monad as GM -import qualified GhcMod.Types as GM +-- import qualified GhcMod.Monad as GM +-- import qualified GhcMod.Types as GM import qualified Language.Haskell.LSP.Core as Core import Haskell.Ide.Engine.MonadTypes import System.Directory @@ -41,16 +41,12 @@ import Text.Blaze.Internal -- --------------------------------------------------------------------- -testOptions :: GM.Options -testOptions = GM.defaultOptions { - GM.optOutput = GM.OutputOpts { - GM.ooptLogLevel = GM.GmError - -- GM.ooptLogLevel = GM.GmVomit - , GM.ooptStyle = GM.PlainStyle - , GM.ooptLineSeparator = GM.LineSeparator "\0" - , GM.ooptLinePrefix = Nothing - } - +testOptions :: BiosOptions +testOptions = defaultOptions { + boLogging = BlError + -- boLoggingg = BlDebug + -- boLoggingg = BlVomit + -- , boGhcUserOptions = ["-v4", "-DDEBUG"] } From 43c3a3b6928b42e806232ca52678a4b0b158606d Mon Sep 17 00:00:00 2001 From: Alan Zimmerman Date: Sun, 28 Apr 2019 14:59:55 +0200 Subject: [PATCH 13/20] Update submodules for all GHC versions --- cabal.project | 1 + stack-8.2.1.yaml | 1 + stack-8.2.2.yaml | 1 + stack-8.4.2.yaml | 1 + stack-8.4.3.yaml | 1 + stack-8.4.4.yaml | 1 + stack-8.6.1.yaml | 1 + stack-8.6.2.yaml | 1 + stack-8.6.3.yaml | 1 + stack-8.6.4.yaml | 1 + 10 files changed, 10 insertions(+) diff --git a/cabal.project b/cabal.project index 0c2906b77..958a340bb 100644 --- a/cabal.project +++ b/cabal.project @@ -8,5 +8,6 @@ packages: ./submodules/floskell ./submodules/ghc-mod/ ./submodules/ghc-mod/core/ + ./submodules/ghc-mod/ghc-project-types tests: true diff --git a/stack-8.2.1.yaml b/stack-8.2.1.yaml index 980b3fbb0..4ec95d42c 100644 --- a/stack-8.2.1.yaml +++ b/stack-8.2.1.yaml @@ -10,6 +10,7 @@ extra-deps: - ./submodules/floskell - ./submodules/ghc-mod - ./submodules/ghc-mod/core +- ./submodules/ghc-mod/ghc-project-types # - brittany-0.11.0.0 - butcher-1.3.1.1 diff --git a/stack-8.2.2.yaml b/stack-8.2.2.yaml index 817986394..2c5ed979f 100644 --- a/stack-8.2.2.yaml +++ b/stack-8.2.2.yaml @@ -10,6 +10,7 @@ extra-deps: - ./submodules/floskell - ./submodules/ghc-mod - ./submodules/ghc-mod/core +- ./submodules/ghc-mod/ghc-project-types # - brittany-0.11.0.0 - butcher-1.3.1.1 diff --git a/stack-8.4.2.yaml b/stack-8.4.2.yaml index 75d0f5340..c8c22f701 100644 --- a/stack-8.4.2.yaml +++ b/stack-8.4.2.yaml @@ -10,6 +10,7 @@ extra-deps: - ./submodules/floskell - ./submodules/ghc-mod - ./submodules/ghc-mod/core +- ./submodules/ghc-mod/ghc-project-types # - brittany-0.11.0.0 - base-compat-0.9.3 diff --git a/stack-8.4.3.yaml b/stack-8.4.3.yaml index cb53357b3..a903859aa 100644 --- a/stack-8.4.3.yaml +++ b/stack-8.4.3.yaml @@ -10,6 +10,7 @@ extra-deps: - ./submodules/floskell - ./submodules/ghc-mod - ./submodules/ghc-mod/core +- ./submodules/ghc-mod/ghc-project-types - base-compat-0.9.3 - cabal-plan-0.3.0.0 diff --git a/stack-8.4.4.yaml b/stack-8.4.4.yaml index a737a8a29..0024cf4bb 100644 --- a/stack-8.4.4.yaml +++ b/stack-8.4.4.yaml @@ -10,6 +10,7 @@ extra-deps: - ./submodules/floskell - ./submodules/ghc-mod - ./submodules/ghc-mod/core +- ./submodules/ghc-mod/ghc-project-types # - brittany-0.11.0.0 - cabal-plan-0.4.0.0 diff --git a/stack-8.6.1.yaml b/stack-8.6.1.yaml index 2a3562f00..bd5368129 100644 --- a/stack-8.6.1.yaml +++ b/stack-8.6.1.yaml @@ -10,6 +10,7 @@ extra-deps: - ./submodules/floskell - ./submodules/ghc-mod - ./submodules/ghc-mod/core +- ./submodules/ghc-mod/ghc-project-types - apply-refact-0.6.0.0 - butcher-1.3.2.1 diff --git a/stack-8.6.2.yaml b/stack-8.6.2.yaml index 6ac106643..f5cb37ef0 100644 --- a/stack-8.6.2.yaml +++ b/stack-8.6.2.yaml @@ -10,6 +10,7 @@ extra-deps: - ./submodules/floskell - ./submodules/ghc-mod - ./submodules/ghc-mod/core +- ./submodules/ghc-mod/ghc-project-types - butcher-1.3.2.1 - cabal-plan-0.4.0.0 diff --git a/stack-8.6.3.yaml b/stack-8.6.3.yaml index 5c556d954..633d5a242 100644 --- a/stack-8.6.3.yaml +++ b/stack-8.6.3.yaml @@ -10,6 +10,7 @@ extra-deps: - ./submodules/floskell - ./submodules/ghc-mod - ./submodules/ghc-mod/core +- ./submodules/ghc-mod/ghc-project-types - butcher-1.3.2.1 - cabal-plan-0.4.0.0 diff --git a/stack-8.6.4.yaml b/stack-8.6.4.yaml index 614979a25..27d304d3d 100644 --- a/stack-8.6.4.yaml +++ b/stack-8.6.4.yaml @@ -10,6 +10,7 @@ extra-deps: - ./submodules/floskell - ./submodules/ghc-mod - ./submodules/ghc-mod/core +- ./submodules/ghc-mod/ghc-project-types - butcher-1.3.2.1 - cabal-plan-0.4.0.0 From 5dcc7f2faa06720b8bf1f9a80a9716cb60e3cdaf Mon Sep 17 00:00:00 2001 From: Alan Zimmerman Date: Sun, 28 Apr 2019 16:44:11 +0200 Subject: [PATCH 14/20] Sort out some compiler warnings --- src/Haskell/Ide/Engine/Plugin/GhcMod.hs | 1 + 1 file changed, 1 insertion(+) diff --git a/src/Haskell/Ide/Engine/Plugin/GhcMod.hs b/src/Haskell/Ide/Engine/Plugin/GhcMod.hs index e1f10aa83..8eb1efff1 100644 --- a/src/Haskell/Ide/Engine/Plugin/GhcMod.hs +++ b/src/Haskell/Ide/Engine/Plugin/GhcMod.hs @@ -15,6 +15,7 @@ module Haskell.Ide.Engine.Plugin.GhcMod , InfoParams(..) , TypeDef(..) , TypeParams(..) + , TypedHoles(..) -- only to keep the GHC 8.4 and below unused field warning happy , ValidSubstitutions(..) , extractHoleSubstitutions , extractMissingSignature From 9c51e7793d980aa9bdfe46ff4c0e74c035237f95 Mon Sep 17 00:00:00 2001 From: Alan Zimmerman Date: Sun, 28 Apr 2019 17:56:10 +0200 Subject: [PATCH 15/20] Use hie-bios version of HaRe --- src/Haskell/Ide/Engine/Plugin/HaRe.hs | 16 ++++++++++------ submodules/HaRe | 2 +- 2 files changed, 11 insertions(+), 7 deletions(-) diff --git a/src/Haskell/Ide/Engine/Plugin/HaRe.hs b/src/Haskell/Ide/Engine/Plugin/HaRe.hs index 55202ea52..0c9988382 100644 --- a/src/Haskell/Ide/Engine/Plugin/HaRe.hs +++ b/src/Haskell/Ide/Engine/Plugin/HaRe.hs @@ -22,7 +22,6 @@ import qualified Data.Text.IO as T import Exception import GHC.Generics (Generic) import qualified GhcMod.Error as GM -import qualified GhcMod.Monad as GM import qualified GhcMod.Utils as GM import Haskell.Ide.Engine.ArtifactMap import Haskell.Ide.Engine.MonadFunctions @@ -241,7 +240,11 @@ runHareCommand name cmd = do -- --------------------------------------------------------------------- -runHareCommand' :: RefactGhc a +-- newtype RefactGhc a = RefactGhc +-- { unRefactGhc :: StateT RefactState HIE.IdeGhcM a +-- } + +runHareCommand' :: forall a. RefactGhc a -> IdeGhcM (Either String a) runHareCommand' cmd = do let initialState = @@ -254,11 +257,11 @@ runHareCommand' cmd = ,rsStorage = StorageNone ,rsCurrentTarget = Nothing ,rsModule = Nothing} - let cmd' = unRefactGhc cmd + let + cmd' :: StateT RefactState IdeGhcM a + cmd' = unRefactGhc cmd embeddedCmd = - GM.unGmlT $ - hoist (liftIO . flip evalStateT initialState) - (GM.GmlT cmd') + evalStateT cmd' initialState handlers :: Applicative m => [GM.GHandler m (Either String a)] @@ -267,6 +270,7 @@ runHareCommand' cmd = ,GM.GHandler (\(err :: GM.GhcModError) -> pure (Left (show err)))] fmap Right embeddedCmd `GM.gcatches` handlers + -- --------------------------------------------------------------------- -- | This is like hoist from the mmorph package, but build on -- `MonadTransControl` since we don’t have an `MFunctor` instance. diff --git a/submodules/HaRe b/submodules/HaRe index 53979f062..a276d45c6 160000 --- a/submodules/HaRe +++ b/submodules/HaRe @@ -1 +1 @@ -Subproject commit 53979f062bebcaa132390d1fd0cec74a51662952 +Subproject commit a276d45c639db41ae59025ecbfcee707a8ca2686 From c16e343c9a4dd1e1b8b194d424e8766c9c7b010b Mon Sep 17 00:00:00 2001 From: Alan Zimmerman Date: Sun, 28 Apr 2019 18:08:18 +0200 Subject: [PATCH 16/20] Bump HaRe submodule to work with GHC 8.2.x --- submodules/HaRe | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/submodules/HaRe b/submodules/HaRe index a276d45c6..dfab00043 160000 --- a/submodules/HaRe +++ b/submodules/HaRe @@ -1 +1 @@ -Subproject commit a276d45c639db41ae59025ecbfcee707a8ca2686 +Subproject commit dfab0004320c28e1aa0331a507a9428952f2c938 From 54a8b61edce9b26acf6320c3a63426d534fdb5e3 Mon Sep 17 00:00:00 2001 From: Alan Zimmerman Date: Sun, 28 Apr 2019 18:42:26 +0200 Subject: [PATCH 17/20] Update comment. [skip ci] [ci skip] --- src/Haskell/Ide/Engine/Scheduler.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Haskell/Ide/Engine/Scheduler.hs b/src/Haskell/Ide/Engine/Scheduler.hs index cc34e8493..d3de638ea 100644 --- a/src/Haskell/Ide/Engine/Scheduler.hs +++ b/src/Haskell/Ide/Engine/Scheduler.hs @@ -100,7 +100,7 @@ newScheduler :: IdePlugins -- ^ The list of plugins that will be used for responding to requests -> BiosOptions - -- ^ Options for the ghc-mod session. Since we only keep a single ghc-mod session + -- ^ Options for the bios session. Since we only keep a single bios session -> IO (Scheduler m) newScheduler plugins biosOpts = do cancelTVar <- STM.atomically $ STM.newTVar Set.empty From d50a1b04b2ebef6a9272d06031277cb96b5705ab Mon Sep 17 00:00:00 2001 From: Alan Zimmerman Date: Sat, 4 May 2019 18:51:23 +0200 Subject: [PATCH 18/20] Apply progress reporting to setTypecheckedModule in its new home It moved from the ghc-mod plugin to hie-plugin-api --- hie-plugin-api/Haskell/Ide/Engine/Ghc.hs | 9 +- .../Haskell/Ide/Engine/PluginApi.hs | 2 +- src/Haskell/Ide/Engine/Plugin/GhcMod.hs | 150 ------------------ 3 files changed, 7 insertions(+), 154 deletions(-) diff --git a/hie-plugin-api/Haskell/Ide/Engine/Ghc.hs b/hie-plugin-api/Haskell/Ide/Engine/Ghc.hs index 7c2c5eccf..54ffd9251 100644 --- a/hie-plugin-api/Haskell/Ide/Engine/Ghc.hs +++ b/hie-plugin-api/Haskell/Ide/Engine/Ghc.hs @@ -35,6 +35,7 @@ import qualified GhcMod.Utils as GM import Haskell.Ide.Engine.MonadFunctions import Haskell.Ide.Engine.MonadTypes import Haskell.Ide.Engine.PluginUtils +import System.FilePath import DynFlags import GHC @@ -164,14 +165,16 @@ setTypecheckedModule uri = rfm <- GM.mkRevRedirMapFunc let ghcErrRes msg = ((Map.empty, [T.pack msg]),Nothing,Nothing) + progTitle = "Typechecking " <> T.pack (takeFileName fp) debugm "setTypecheckedModule: before ghc-mod" -- TODO:AZ: loading this one module may/should trigger loads of any -- other modules which currently have a VFS entry. Need to make -- sure that their diagnostics are reported, and their module -- cache entries are updated. - ((diags', errs), mtm, mpm) <- GM.gcatches - (GM.getModulesGhc' (myWrapper rfm) fp) - (errorHandlers ghcErrRes (return . ghcErrRes . show)) + -- TODO: Are there any hooks we can use to report back on the progress? + ((diags', errs), mtm, mpm) <- withIndefiniteProgress progTitle NotCancellable $ GM.gcatches + (GM.getModulesGhc' (myWrapper rfm) fp) + (errorHandlers ghcErrRes (return . ghcErrRes . show)) debugm "setTypecheckedModule: after ghc-mod" canonUri <- canonicalizeUri uri diff --git a/hie-plugin-api/Haskell/Ide/Engine/PluginApi.hs b/hie-plugin-api/Haskell/Ide/Engine/PluginApi.hs index be98cd114..55bf6b61b 100644 --- a/hie-plugin-api/Haskell/Ide/Engine/PluginApi.hs +++ b/hie-plugin-api/Haskell/Ide/Engine/PluginApi.hs @@ -42,7 +42,7 @@ module Haskell.Ide.Engine.PluginApi , HIE.IdeM , HIE.runIdeM , HIE.IdeDeferM - , HIE.MonadIde(..) + , HIE.MonadIde , HIE.iterT , HIE.LiftsToGhc(..) , HIE.HasGhcModuleCache(..) diff --git a/src/Haskell/Ide/Engine/Plugin/GhcMod.hs b/src/Haskell/Ide/Engine/Plugin/GhcMod.hs index 04187a514..8eb1efff1 100644 --- a/src/Haskell/Ide/Engine/Plugin/GhcMod.hs +++ b/src/Haskell/Ide/Engine/Plugin/GhcMod.hs @@ -35,8 +35,6 @@ import Data.List import Data.Maybe import Data.Monoid ((<>)) import qualified Data.Text as T -import System.FilePath -import ErrUtils import Name import GHC.Generics import qualified GhcMod as GM @@ -88,154 +86,6 @@ checkCmd = CmdSync setTypecheckedModule -- --------------------------------------------------------------------- -lspSev :: Severity -> DiagnosticSeverity -lspSev SevWarning = DsWarning -lspSev SevError = DsError -lspSev SevFatal = DsError -lspSev SevInfo = DsInfo -lspSev _ = DsInfo - --- type LogAction = DynFlags -> WarnReason -> Severity -> SrcSpan -> PprStyle -> MsgDoc -> IO () -logDiag :: (FilePath -> FilePath) -> IORef AdditionalErrs -> IORef Diagnostics -> LogAction -logDiag rfm eref dref df _reason sev spn style msg = do - eloc <- srcSpan2Loc rfm spn - let msgTxt = T.pack $ renderWithStyle df msg style - case eloc of - Right (Location uri range) -> do - let update = Map.insertWith Set.union uri l - where l = Set.singleton diag - diag = Diagnostic range (Just $ lspSev sev) Nothing (Just "ghcmod") msgTxt Nothing - modifyIORef' dref update - Left _ -> do - modifyIORef' eref (msgTxt:) - return () - -unhelpfulSrcSpanErr :: T.Text -> IdeError -unhelpfulSrcSpanErr err = - IdeError PluginError - ("Unhelpful SrcSpan" <> ": \"" <> err <> "\"") - Null - -srcErrToDiag :: MonadIO m - => DynFlags - -> (FilePath -> FilePath) - -> SourceError -> m (Diagnostics, AdditionalErrs) -srcErrToDiag df rfm se = do - debugm "in srcErrToDiag" - let errMsgs = bagToList $ srcErrorMessages se - processMsg err = do - let sev = Just DsError - unqual = errMsgContext err - st = GM.mkErrStyle' df unqual - msgTxt = T.pack $ renderWithStyle df (pprLocErrMsg err) st - eloc <- srcSpan2Loc rfm $ errMsgSpan err - case eloc of - Right (Location uri range) -> - return $ Right (uri, Diagnostic range sev Nothing (Just "ghcmod") msgTxt Nothing) - Left _ -> return $ Left msgTxt - processMsgs [] = return (Map.empty,[]) - processMsgs (x:xs) = do - res <- processMsg x - (m,es) <- processMsgs xs - case res of - Right (uri, diag) -> - return (Map.insertWith Set.union uri (Set.singleton diag) m, es) - Left e -> return (m, e:es) - processMsgs errMsgs - -myWrapper :: GM.IOish m - => (FilePath -> FilePath) - -> GM.GmlT m () - -> GM.GmlT m (Diagnostics, AdditionalErrs) -myWrapper rfm action = do - env <- getSession - diagRef <- liftIO $ newIORef Map.empty - errRef <- liftIO $ newIORef [] - let setLogger df = df { log_action = logDiag rfm errRef diagRef } - setDeferTypedHoles = setGeneralFlag' Opt_DeferTypedHoles - ghcErrRes msg = (Map.empty, [T.pack msg]) - handlers = errorHandlers ghcErrRes (srcErrToDiag (hsc_dflags env) rfm ) - action' = do - GM.withDynFlags (setLogger . setDeferTypedHoles) action - diags <- liftIO $ readIORef diagRef - errs <- liftIO $ readIORef errRef - return (diags,errs) - GM.gcatches action' handlers - -errorHandlers :: (Monad m) => (String -> a) -> (SourceError -> m a) -> [GM.GHandler m a] -errorHandlers ghcErrRes renderSourceError = handlers - where - -- ghc throws GhcException, SourceError, GhcApiError and - -- IOEnvFailure. ghc-mod-core throws GhcModError. - handlers = - [ GM.GHandler $ \(ex :: GM.GhcModError) -> - return $ ghcErrRes (show ex) - , GM.GHandler $ \(ex :: IOEnvFailure) -> - return $ ghcErrRes (show ex) - , GM.GHandler $ \(ex :: GhcApiError) -> - return $ ghcErrRes (show ex) - , GM.GHandler $ \(ex :: SourceError) -> - renderSourceError ex - , GM.GHandler $ \(ex :: GhcException) -> - return $ ghcErrRes $ GM.renderGm $ GM.ghcExceptionDoc ex - , GM.GHandler $ \(ex :: IOError) -> - return $ ghcErrRes (show ex) - -- , GM.GHandler $ \(ex :: GM.SomeException) -> - -- return $ ghcErrRes (show ex) - ] - -setTypecheckedModule :: Uri -> IdeGhcM (IdeResult (Diagnostics, AdditionalErrs)) -setTypecheckedModule uri = - pluginGetFile "setTypecheckedModule: " uri $ \fp -> do - fileMap <- GM.getMMappedFiles - debugm $ "setTypecheckedModule: file mapping state is: " ++ show fileMap - rfm <- GM.mkRevRedirMapFunc - let - ghcErrRes msg = ((Map.empty, [T.pack msg]),Nothing,Nothing) - progTitle = "Typechecking " <> T.pack (takeFileName fp) - debugm "setTypecheckedModule: before ghc-mod" - -- TODO: Are there any hooks we can use to report back on the progress? - ((diags', errs), mtm, mpm) <- withIndefiniteProgress progTitle NotCancellable $ GM.gcatches - (GM.getModulesGhc' (myWrapper rfm) fp) - (errorHandlers ghcErrRes (return . ghcErrRes . show)) - debugm "setTypecheckedModule: after ghc-mod" - - canonUri <- canonicalizeUri uri - let diags = Map.insertWith Set.union canonUri Set.empty diags' - diags2 <- case (mpm,mtm) of - (Just pm, Nothing) -> do - debugm $ "setTypecheckedModule: Did get parsed module for: " ++ show fp - cacheModule fp (Left pm) - debugm "setTypecheckedModule: done" - return diags - - (_, Just tm) -> do - debugm $ "setTypecheckedModule: Did get typechecked module for: " ++ show fp - sess <- fmap GM.gmgsSession . GM.gmGhcSession <$> GM.gmsGet - - -- set the session before we cache the module, so that deferred - -- responses triggered by cacheModule can access it - modifyMTS (\s -> s {ghcSession = sess}) - cacheModule fp (Right tm) - debugm "setTypecheckedModule: done" - return diags - - _ -> do - debugm $ "setTypecheckedModule: Didn't get typechecked or parsed module for: " ++ show fp - debugm $ "setTypecheckedModule: errs: " ++ show errs - - failModule fp - - let sev = Just DsError - range = Range (Position 0 0) (Position 1 0) - msgTxt = T.unlines errs - let d = Diagnostic range sev Nothing (Just "ghcmod") msgTxt Nothing - return $ Map.insertWith Set.union canonUri (Set.singleton d) diags - - return $ IdeResultOk (diags2,errs) - --- --------------------------------------------------------------------- - lintCmd :: CommandFunc Uri T.Text lintCmd = CmdSync lintCmd' From 84b0405fce31adf928a388c6ef5ef1da660a22a6 Mon Sep 17 00:00:00 2001 From: Alan Zimmerman Date: Sat, 4 May 2019 20:15:07 +0200 Subject: [PATCH 19/20] Fix build for GHC 8.2 --- hie-plugin-api/Haskell/Ide/Engine/Ghc.hs | 1 + 1 file changed, 1 insertion(+) diff --git a/hie-plugin-api/Haskell/Ide/Engine/Ghc.hs b/hie-plugin-api/Haskell/Ide/Engine/Ghc.hs index 54ffd9251..569613f41 100644 --- a/hie-plugin-api/Haskell/Ide/Engine/Ghc.hs +++ b/hie-plugin-api/Haskell/Ide/Engine/Ghc.hs @@ -29,6 +29,7 @@ import qualified GhcMod.Error as GM import qualified GhcMod.Gap as GM import qualified GhcMod.ModuleLoader as GM import qualified GhcMod.Monad as GM +import Data.Monoid ((<>)) import qualified GhcMod.Target as GM import qualified GhcMod.Types as GM import qualified GhcMod.Utils as GM From bf612fcce13e466b405e350c3ba2bbdabf63c3e2 Mon Sep 17 00:00:00 2001 From: Alan Zimmerman Date: Sat, 4 May 2019 20:17:23 +0200 Subject: [PATCH 20/20] Fix GHC 8.6.5 build too --- stack-8.6.5.yaml | 1 + 1 file changed, 1 insertion(+) diff --git a/stack-8.6.5.yaml b/stack-8.6.5.yaml index 25601fa42..e06acd30e 100644 --- a/stack-8.6.5.yaml +++ b/stack-8.6.5.yaml @@ -10,6 +10,7 @@ extra-deps: - ./submodules/floskell - ./submodules/ghc-mod - ./submodules/ghc-mod/core +- ./submodules/ghc-mod/ghc-project-types - ansi-terminal-0.8.2 - butcher-1.3.2.1