Merge pull request #1255 from alanz/narrow-ghc-mod-core

alanz · web-flow · commit 6254c09fbc90 · 2019-05-12T15:38:29.000+02:00
Narrow ghc mod core
diff --git a/app/HieWrapper.hs b/app/HieWrapper.hs
@@ -10,6 +10,7 @@ import           Data.List
 import           Data.Foldable
 import           Data.Version                          (showVersion)
 import qualified GhcMod.Monad                          as GM
+import qualified GhcMod.Monad.Types                    as GM
 import qualified GhcMod.Types                          as GM
 import           Haskell.Ide.Engine.MonadFunctions
 import           Haskell.Ide.Engine.Options
diff --git a/haskell-ide-engine.cabal b/haskell-ide-engine.cabal
@@ -107,7 +107,6 @@ executable hie
   other-modules:       Paths_haskell_ide_engine
   build-depends:       base
                      , directory
-                     , ghc-mod-core
                      , haskell-ide-engine
                      , haskell-lsp
                      , hie-plugin-api
diff --git a/hie-plugin-api/Haskell/Ide/Engine/ArtifactMap.hs b/hie-plugin-api/Haskell/Ide/Engine/ArtifactMap.hs
@@ -9,7 +9,7 @@ import qualified GHC
 import           GHC                               (TypecheckedModule)
 import qualified SrcLoc                            as GHC
 import qualified Var
-import qualified GhcMod.Gap                        as GM
+import qualified GhcModCore                        as GM ( GhcRn, GhcTc, GhcPs )
 
 import           Language.Haskell.LSP.Types
 
diff --git a/hie-plugin-api/Haskell/Ide/Engine/Context.hs b/hie-plugin-api/Haskell/Ide/Engine/Context.hs
@@ -3,7 +3,7 @@ module Haskell.Ide.Engine.Context where
 import Data.Generics
 import Language.Haskell.LSP.Types
 import GHC
-import GhcMod.Gap (GhcPs) -- for GHC 8.2.2
+import qualified GhcModCore as GM (GhcPs) -- for GHC 8.2.2
 import Haskell.Ide.Engine.PluginUtils
 
 -- | A context of a declaration in the program
@@ -20,15 +20,15 @@ data Context = TypeContext
 getContext :: Position -> ParsedModule -> Maybe Context
 getContext pos pm = everything join (Nothing `mkQ` go `extQ` goInline) decl
   where decl = hsmodDecls $ unLoc $ pm_parsed_source pm
-        go :: LHsDecl GhcPs -> Maybe Context
+        go :: LHsDecl GM.GhcPs -> Maybe Context
         go (L (RealSrcSpan r) (SigD {}))
           | pos `isInsideRange` r = Just TypeContext
           | otherwise = Nothing
         go (L (GHC.RealSrcSpan r) (GHC.ValD {}))
           | pos `isInsideRange` r = Just ValueContext
           | otherwise = Nothing
         go _ = Nothing
-        goInline :: GHC.LHsType GhcPs -> Maybe Context
+        goInline :: GHC.LHsType GM.GhcPs -> Maybe Context
         goInline (GHC.L (GHC.RealSrcSpan r) _)
           | pos `isInsideRange` r = Just TypeContext
           | otherwise = Nothing
diff --git a/hie-plugin-api/Haskell/Ide/Engine/Ghc.hs b/hie-plugin-api/Haskell/Ide/Engine/Ghc.hs
@@ -21,18 +21,20 @@ import           Bag
 import           Control.Monad.IO.Class
 import           Data.IORef
 import qualified Data.Map.Strict                   as Map
+import           Data.Monoid ((<>))
 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           Data.Monoid ((<>))
-import qualified GhcMod.Target                     as GM
-import qualified GhcMod.Types                      as GM
-import qualified GhcMod.Utils                      as GM
+
+import qualified GhcModCore                   as GM ( withDynFlags
+                                                    , gcatches, GHandler(..), ghcExceptionDoc
+                                                    , mkErrStyle', renderGm
+                                                    , getModulesGhc'
+                                                    , GmlT(..), getMMappedFiles, GmState(..), GhcModT, cradle
+                                                    , cabalResolvedComponents
+                                                    , IOish, GhcModError(..), GmGhcSession(..), GhcModState(..), GmModuleGraph(..), Cradle(..), gmcHomeModuleGraph
+                                                    , mkRevRedirMapFunc )
+
 import           Haskell.Ide.Engine.MonadFunctions
 import           Haskell.Ide.Engine.MonadTypes
 import           Haskell.Ide.Engine.PluginUtils
diff --git a/hie-plugin-api/Haskell/Ide/Engine/GhcModuleCache.hs b/hie-plugin-api/Haskell/Ide/Engine/GhcModuleCache.hs
@@ -8,7 +8,7 @@ import qualified Data.Map as Map
 import           Data.Dynamic (Dynamic)
 import           Data.Typeable (TypeRep)
 
-import qualified GhcMod.Types                      as GM
+import qualified GhcModCore                      as GM ( Cradle(..) )
 
 import           GHC                               (TypecheckedModule, ParsedModule)
 
diff --git a/hie-plugin-api/Haskell/Ide/Engine/ModuleCache.hs b/hie-plugin-api/Haskell/Ide/Engine/ModuleCache.hs
@@ -35,10 +35,11 @@ import           Exception (ExceptionMonad)
 import           System.Directory
 import           System.FilePath
 
-import qualified GhcMod.Cradle as GM
-import qualified GhcMod.Monad  as GM
-import qualified GhcMod.Types  as GM
-import qualified GhcMod.Utils  as GM
+import qualified GhcModCore as GM ( findCradle'
+                                  , GmEnv(..), GmLog(..), GmlT(..), GmOut(..), cradle, options
+                                  , Cradle(..), GhcModEnv(..), MonadIO(..), Options(..)
+                                  , mkRevRedirMapFunc )
+
 import qualified GHC           as GHC
 
 import           Haskell.Ide.Engine.ArtifactMap
diff --git a/hie-plugin-api/Haskell/Ide/Engine/PluginUtils.hs b/hie-plugin-api/Haskell/Ide/Engine/PluginUtils.hs
@@ -45,7 +45,7 @@ import           Data.Monoid
 import qualified Data.Text                             as T
 import qualified Data.Text.IO                          as T
 import           Data.Maybe
-import qualified GhcMod.Utils                          as GM
+import qualified GhcModCore                          as GM ( makeAbsolute' )
 import           FastString
 import           Haskell.Ide.Engine.MonadTypes
 import           Haskell.Ide.Engine.MonadFunctions
diff --git a/hie-plugin-api/Haskell/Ide/Engine/PluginsIdeMonads.hs b/hie-plugin-api/Haskell/Ide/Engine/PluginsIdeMonads.hs
@@ -117,8 +117,9 @@ import           Data.Typeable                  ( TypeRep
                                                 , Typeable
                                                 )
 
-import qualified GhcMod.Monad                  as GM
-import qualified GhcMod.Types                  as GM
+import qualified GhcModCore                  as GM ( GhcModT, runGhcModT, GmlT(..), gmlGetSession, gmlSetSession
+                                                   , MonadIO(..), GmLogLevel(..), Options(..), defaultOptions, OutputOpts(..) )
+
 import           GHC.Generics
 import           GHC                            ( HscEnv )
 import qualified DynFlags      as GHC
diff --git a/src/Haskell/Ide/Engine/Plugin/ApplyRefact.hs b/src/Haskell/Ide/Engine/Plugin/ApplyRefact.hs
@@ -19,7 +19,7 @@ import           Data.Maybe
 import           Data.Monoid                       ((<>))
 import qualified Data.Text                         as T
 import           GHC.Generics
-import qualified GhcMod.Utils                      as GM
+import qualified GhcModCore                      as GM ( mkRevRedirMapFunc, withMappedFile )
 import           Haskell.Ide.Engine.MonadFunctions
 import           Haskell.Ide.Engine.MonadTypes
 import           Haskell.Ide.Engine.PluginUtils
@@ -111,9 +111,9 @@ lintCmd = CmdSync $ \uri -> do
 -- AZ:TODO: Why is this in IdeGhcM?
 lintCmd' :: Uri -> IdeGhcM (IdeResult PublishDiagnosticsParams)
 lintCmd' uri = pluginGetFile "lintCmd: " uri $ \fp -> do
-  eitherErrorResult <- GM.withMappedFile fp $ \file' -> 
+  eitherErrorResult <- GM.withMappedFile fp $ \file' ->
     liftIO (try $ runExceptT $ runLintCmd file' [] :: IO (Either IOException (Either [Diagnostic] [Idea])))
-  
+
   case eitherErrorResult of
     Left err ->
       return
diff --git a/src/Haskell/Ide/Engine/Plugin/GhcMod.hs b/src/Haskell/Ide/Engine/Plugin/GhcMod.hs
@@ -12,7 +12,6 @@ module Haskell.Ide.Engine.Plugin.GhcMod
   -- * For tests
   , Bindings(..)
   , FunctionSig(..)
-  , InfoParams(..)
   , TypeDef(..)
   , TypeParams(..)
   , TypedHoles(..) -- only to keep the GHC 8.4 and below unused field warning happy
@@ -21,8 +20,6 @@ module Haskell.Ide.Engine.Plugin.GhcMod
   , extractMissingSignature
   , extractRenamableTerms
   , extractUnusedTerm
-  , infoCmd'
-  , lintCmd'
   , newTypeCmd
   , symbolProvider
   ) where
@@ -37,10 +34,7 @@ import           Data.Monoid ((<>))
 import qualified Data.Text                         as T
 import           Name
 import           GHC.Generics
-import qualified GhcMod                            as GM
-import qualified GhcMod.Gap                        as GM
-import qualified GhcMod.SrcUtils                   as GM
-import qualified GhcMod.Types                      as GM
+import qualified GhcModCore                        as GM ( pretty, GhcPs )
 import           Haskell.Ide.Engine.Ghc
 import           Haskell.Ide.Engine.MonadTypes hiding (defaultOptions)
 import           Haskell.Ide.Engine.PluginUtils
@@ -66,10 +60,14 @@ ghcmodDescriptor plId = PluginDescriptor
               <> "in editors. It strives to offer most of the features one has come to expect "
               <> "from modern IDEs in any editor."
   , pluginCommands =
-      [ PluginCommand "check" "check a file for GHC warnings and errors" checkCmd
-      , PluginCommand "lint" "Check files using `hlint'" lintCmd
-      , PluginCommand "info" "Look up an identifier in the context of FILE (like ghci's `:info')" infoCmd
+      [
+        -- This one is used in the dispatcher tests, and is a wrapper around what we are already using anyway
+        PluginCommand "check" "check a file for GHC warnings and errors" checkCmd
+
+        -- PluginCommand "info" "Look up an identifier in the context of FILE (like ghci's `:info')" infoCmd
       , PluginCommand "type" "Get the type of the expression under (LINE,COL)" typeCmd
+
+        -- This one is registered in the vscode plugin, for some reason
       , PluginCommand "casesplit" "Generate a pattern match for a binding under (LINE,COL)" Hie.splitCaseCmd
       ]
   , pluginCodeActionProvider = Just codeActionProvider
@@ -86,39 +84,11 @@ checkCmd = CmdSync setTypecheckedModule
 
 -- ---------------------------------------------------------------------
 
-lintCmd :: CommandFunc Uri T.Text
-lintCmd = CmdSync lintCmd'
-
-lintCmd' :: Uri -> IdeGhcM (IdeResult T.Text)
-lintCmd' uri =
-  pluginGetFile "lint: " uri $ \file ->
-    fmap T.pack <$> Hie.runGhcModCommand (GM.lint GM.defaultLintOpts file)
-
--- ---------------------------------------------------------------------
-
 customOptions :: Options
 customOptions = defaultOptions { fieldLabelModifier = camelTo2 '_' . drop 2}
 
-data InfoParams =
-  IP { ipFile :: Uri
-     , ipExpr :: T.Text
-     } deriving (Eq,Show,Generic)
-
-instance FromJSON InfoParams where
-  parseJSON = genericParseJSON customOptions
-instance ToJSON InfoParams where
-  toJSON = genericToJSON customOptions
-
-infoCmd :: CommandFunc InfoParams T.Text
-infoCmd = CmdSync $ \(IP uri expr) ->
-  infoCmd' uri expr
-
-infoCmd' :: Uri -> T.Text -> IdeGhcM (IdeResult T.Text)
-infoCmd' uri expr =
-  pluginGetFile "info: " uri $ \file ->
-    fmap T.pack <$> Hie.runGhcModCommand (GM.info file (GM.Expression (T.unpack expr)))
-
 -- ---------------------------------------------------------------------
+
 data TypeParams =
   TP { tpIncludeConstraints :: Bool
      , tpFile               :: Uri
diff --git a/src/Haskell/Ide/Engine/Plugin/HaRe.hs b/src/Haskell/Ide/Engine/Plugin/HaRe.hs
@@ -21,8 +21,9 @@ import qualified Data.Text                                    as T
 import qualified Data.Text.IO                                 as T
 import           Exception
 import           GHC.Generics                                 (Generic)
-import qualified GhcMod.Error                                 as GM
-import qualified GhcMod.Utils                                 as GM
+
+import qualified GhcModCore              as GM (GhcModError(..),withMappedFile,GHandler(..),gcatches)
+
 import           Haskell.Ide.Engine.ArtifactMap
 import           Haskell.Ide.Engine.MonadFunctions
 import           Haskell.Ide.Engine.MonadTypes
diff --git a/src/Haskell/Ide/Engine/Plugin/Haddock.hs b/src/Haskell/Ide/Engine/Plugin/Haddock.hs
@@ -18,8 +18,7 @@ import Data.Function
 import Data.Maybe
 import Data.List
 import           GHC
-import qualified GhcMod.LightGhc                              as GM
-import qualified GhcMod.Monad                                 as GM
+import qualified GhcModCore                           as GM ( LightGhc(..), runLightGhc )
 import           GhcMonad
 import           Haskell.Ide.Engine.MonadFunctions
 import           Haskell.Ide.Engine.MonadTypes
diff --git a/src/Haskell/Ide/Engine/Plugin/HsImport.hs b/src/Haskell/Ide/Engine/Plugin/HsImport.hs
@@ -17,7 +17,7 @@ import           Data.Monoid                    ( (<>) )
 import qualified Data.Text                     as T
 import qualified Data.Text.IO                  as T
 import qualified GHC.Generics                  as Generics
-import qualified GhcMod.Utils                  as GM
+import qualified GhcModCore                    as GM ( mkRevRedirMapFunc, withMappedFile )
 import           HsImport
 import           Haskell.Ide.Engine.Config
 import           Haskell.Ide.Engine.MonadTypes
diff --git a/src/Haskell/Ide/Engine/Plugin/Package.hs b/src/Haskell/Ide/Engine/Plugin/Package.hs
@@ -44,7 +44,7 @@ import           System.FilePath
 #endif
 import           Control.Monad.IO.Class
 import           System.Directory
-import qualified GhcMod.Utils                  as GM
+import qualified GhcModCore                  as GM ( mkRevRedirMapFunc )
 import           Distribution.Types.GenericPackageDescription
 import           Distribution.Types.CondTree
 import qualified Distribution.PackageDescription.PrettyPrint as PP
diff --git a/src/Haskell/Ide/Engine/Scheduler.hs b/src/Haskell/Ide/Engine/Scheduler.hs
@@ -32,7 +32,6 @@ import           Control.Monad
 import qualified Data.Set                      as Set
 import qualified Data.Map                      as Map
 import qualified Data.Text                     as T
-import qualified GhcMod.Types                  as GM
 import qualified Language.Haskell.LSP.Core     as Core
 import qualified Language.Haskell.LSP.Types    as J
 
@@ -348,7 +347,8 @@ ghcDispatcher env@DispatcherEnv { docVersionTVar } errorHandler callbackHandler
 -- | Runs the passed monad only if the request identified by the passed LspId
 -- has not already been cancelled.
 unlessCancelled
-  :: GM.MonadIO m => DispatcherEnv -> J.LspId -> ErrorHandler -> m () -> m ()
+  -- :: GM.MonadIO m => DispatcherEnv -> J.LspId -> ErrorHandler -> m () -> m ()
+  :: MonadIO m => DispatcherEnv -> J.LspId -> ErrorHandler -> m () -> m ()
 unlessCancelled env lid errorHandler callback = do
   cancelled <- liftIO $ STM.atomically isCancelled
   if cancelled
diff --git a/src/Haskell/Ide/Engine/Support/HieExtras.hs b/src/Haskell/Ide/Engine/Support/HieExtras.hs
@@ -50,11 +50,10 @@ import           FastString
 import           Finder
 import           GHC                                          hiding (getContext)
 import           GHC.Generics                                 (Generic)
-import qualified GhcMod.Error                                 as GM
-import qualified GhcMod.Exe.CaseSplit                         as GM
-import qualified GhcMod.Gap                                   as GM
-import qualified GhcMod.LightGhc                              as GM
-import qualified GhcMod.Utils                                 as GM
+
+import qualified GhcMod                                       as GM (splits',SplitResult(..))
+import qualified GhcModCore                                   as GM (GhcModError(..), listVisibleModuleNames,runLightGhc, withMappedFile )
+
 import           Haskell.Ide.Engine.ArtifactMap
 import           Haskell.Ide.Engine.Config
 import           Haskell.Ide.Engine.Context
diff --git a/src/Haskell/Ide/Engine/Transport/LspStdio.hs b/src/Haskell/Ide/Engine/Transport/LspStdio.hs
@@ -38,8 +38,7 @@ import qualified Data.Set as S
 import qualified Data.SortedList as SL
 import qualified Data.Text as T
 import           Data.Text.Encoding
-import qualified GhcMod.Monad.Types       as GM
-import qualified GhcModCore               as GM
+import qualified GhcModCore               as GM ( loadMappedFileSource, getMMappedFiles )
 import           Haskell.Ide.Engine.Config
 import qualified Haskell.Ide.Engine.Ghc   as HIE
 import           Haskell.Ide.Engine.LSP.CodeActions
diff --git a/submodules/cabal-helper b/submodules/cabal-helper
@@ -1 +1 @@
-Subproject commit 754e60fbce458ee4311a3ed59e5de6ee80f5a512
+Subproject commit eafed5e8c1d82b8daa35775b52361132f2e70261
diff --git a/submodules/ghc-mod b/submodules/ghc-mod
@@ -1 +1 @@
-Subproject commit 17403cedeaa85e5d78d548afc95e1467cc3f5720
+Subproject commit 43476965b5d715f7fcdadd9e14d5e0c53cdb9385
diff --git a/test/dispatcher/Main.hs b/test/dispatcher/Main.hs
@@ -166,7 +166,7 @@ funcSpec = describe "functional dispatch" $ do
       -- And now we get the deferred response (once the module is loaded)
       ("req1",Right res) <- atomically $ readTChan logChan
       let Just ds = fromDynJSON res :: Maybe [DocumentSymbol]
-          DocumentSymbol mainName _ mainKind _ mainRange _ _ = head ds 
+          DocumentSymbol mainName _ mainKind _ mainRange _ _ = head ds
       mainName `shouldBe` "main"
       mainKind `shouldBe` SkFunction
       mainRange `shouldBe` Range (Position 2 0) (Position 2 23)
diff --git a/test/unit/GhcModPluginSpec.hs b/test/unit/GhcModPluginSpec.hs
diff --git a/test/unit/JsonSpec.hs b/test/unit/JsonSpec.hs
