Compatibility with fbghc (#892)

* Compatibility with fbghc

Rather than forking ghcide, we use conditional compilation to build with https://github.com/facebook/fbghc hopefully only until certain changes have been upstreamed.

* Reexport DynFlags from Compat.GHC

* Add a link to the fbghc repo

session-loader/Development/IDE/Session.hs

@@ -59,7 +59,6 @@ import System.Info
 import System.IO
 
 import GHCi
-import DynFlags
 import HscTypes (ic_dflags, hsc_IC, hsc_dflags, hsc_NC)
 import Linker
 import Module

src/Development/IDE/Core/Preprocessor.hs

@@ -15,7 +15,6 @@ import Data.List.Extra
 import System.FilePath
 import System.IO.Extra
 import Data.Char
-import DynFlags
 import qualified HeaderInfo as Hdr
 import Development.IDE.Types.Diagnostics
 import Development.IDE.Types.Location

src/Development/IDE/Core/Rules.hs

@@ -69,7 +69,6 @@ import           Language.Haskell.LSP.Types (DocumentHighlight (..))
 
 import qualified GHC.LanguageExtensions as LangExt
 import HscTypes hiding (TargetModule, TargetFile)
-import DynFlags (gopt_set, xopt)
 import GHC.Generics(Generic)
 
 import qualified Development.IDE.Spans.AtPoint as AtPoint
@@ -527,7 +526,7 @@ getHieAstsRule =
 getHieAstRuleDefinition :: NormalizedFilePath -> HscEnv -> TcModuleResult -> Action (IdeResult HieAstResult)
 getHieAstRuleDefinition f hsc tmr = do
   (diags, masts) <- liftIO $ generateHieAsts hsc tmr
- 
+
   isFoi <- use_ IsFileOfInterest f
   diagsWrite <- case isFoi of
     IsFOI Modified -> pure []
@@ -535,7 +534,7 @@ getHieAstRuleDefinition f hsc tmr = do
           source <- getSourceFileSource f
           liftIO $ writeHieFile hsc (tmrModSummary tmr) (tcg_exports $ tmrTypechecked tmr) asts source
     _ -> pure []
- 
+
   let refmap = generateReferencesMap . getAsts <$> masts
   pure (diags <> diagsWrite, HAR (ms_mod  $ tmrModSummary tmr) <$> masts <*> refmap)
 

src/Development/IDE/GHC/CPP.hs

@@ -26,7 +26,6 @@ import Development.IDE.GHC.Compat
 import Packages
 import SysTools
 import Module
-import DynFlags
 import Panic
 import FileCleanup
 #if MIN_GHC_API_VERSION(8,8,2)

src/Development/IDE/GHC/Compat.hs

@@ -28,8 +28,6 @@ module Development.IDE.GHC.Compat(
     addBootSuffixLocnOut,
 #endif
     hPutStringBuffer,
-    includePathsGlobal,
-    includePathsQuote,
     addIncludePathsQuote,
     getModuleHash,
     getPackageName,
@@ -37,6 +35,7 @@ module Development.IDE.GHC.Compat(
     GHC.ModLocation,
     Module.addBootSuffix,
     pattern ModLocation,
+    pattern ExposePackage,
     HasSrcSpan,
     getLoc,
     upNameCache,
@@ -54,6 +53,7 @@ module Development.IDE.GHC.Compat(
 #endif
 
     module GHC,
+    module DynFlags,
     initializePlugins,
     applyPluginsParsedResultAction,
     module Compat.HieTypes,
@@ -66,7 +66,8 @@ import LinkerTypes
 #endif
 
 import StringBuffer
-import DynFlags
+import qualified DynFlags
+import DynFlags hiding (ExposePackage)
 import Fingerprint (Fingerprint)
 import qualified Module
 import Packages
@@ -271,6 +272,14 @@ applyPluginsParsedResultAction :: HscEnv -> DynFlags -> ModSummary -> ApiAnns ->
 applyPluginsParsedResultAction env dflags ms hpm_annotations parsed = do
   -- Apply parsedResultAction of plugins
   let applyPluginAction p opts = parsedResultAction p opts ms
-  fmap hpm_module $ 
-    runHsc env $ withPlugins dflags applyPluginAction 
+  fmap hpm_module $
+    runHsc env $ withPlugins dflags applyPluginAction
       (HsParsedModule parsed [] hpm_annotations)
+
+pattern ExposePackage :: String -> PackageArg -> ModRenaming -> PackageFlag
+-- https://github.com/facebook/fbghc
+#ifdef __FACEBOOK_HASKELL__
+pattern ExposePackage s a mr <- DynFlags.ExposePackage s a _ mr
+#else
+pattern ExposePackage s a mr = DynFlags.ExposePackage s a mr
+#endif

src/Development/IDE/GHC/Util.hs

@@ -68,7 +68,6 @@ import Outputable (showSDocUnsafe, ppr, showSDoc, Outputable)
 import Packages (getPackageConfigMap, lookupPackage')
 import SrcLoc (mkRealSrcLoc)
 import FastString (mkFastString)
-import DynFlags (emptyFilesToClean, unsafeGlobalDynFlags)
 import Module (moduleNameSlashes, InstalledUnitId)
 import OccName (parenSymOcc)
 import RdrName (nameRdrName, rdrNameOcc)

src/Development/IDE/Plugin/CodeAction.hs

@@ -54,7 +54,6 @@ import HscTypes
 import Parser
 import Text.Regex.TDFA (mrAfter, (=~), (=~~))
 import Outputable (ppr, showSDocUnsafe)
-import DynFlags (xFlags, FlagSpec(..))
 import GHC.LanguageExtensions.Type (Extension)
 import Data.Function
 import Control.Arrow ((>>>))
@@ -172,7 +171,7 @@ suggestAction dflags packageExports ideOptions parsedModule text diag = concat
     , removeRedundantConstraints text diag
     , suggestAddTypeAnnotationToSatisfyContraints text diag
     ] ++ concat
-    [  suggestConstraint pm text diag  
+    [  suggestConstraint pm text diag
     ++ suggestNewDefinition ideOptions pm text diag
     ++ suggestNewImport packageExports pm diag
     ++ suggestDeleteUnusedBinding pm text diag
@@ -696,7 +695,7 @@ suggestConstraint parsedModule mContents diag@Diagnostic {..}
   | Just contents <- mContents
   , Just missingConstraint <- findMissingConstraint _message
   = let codeAction = if _message =~ ("the type signature for:" :: String)
-                        then suggestFunctionConstraint parsedModule 
+                        then suggestFunctionConstraint parsedModule
                         else suggestInstanceConstraint contents
      in codeAction diag missingConstraint
   | otherwise = []
@@ -798,14 +797,14 @@ suggestFunctionConstraint ParsedModule{pm_parsed_source = L _ HsModule{hsmodDecl
   | Just typeSignatureName <- findTypeSignatureName _message
   = let mExistingConstraints = findExistingConstraints _message
         newConstraint = buildNewConstraints missingConstraint mExistingConstraints
-     in case findRangeOfContextForFunctionNamed typeSignatureName of 
+     in case findRangeOfContextForFunctionNamed typeSignatureName of
        Just range -> [(actionTitle missingConstraint typeSignatureName, [TextEdit range newConstraint])]
        Nothing -> []
   | otherwise = []
     where
-      findRangeOfContextForFunctionNamed :: T.Text -> Maybe Range 
+      findRangeOfContextForFunctionNamed :: T.Text -> Maybe Range
       findRangeOfContextForFunctionNamed typeSignatureName = do
-          locatedType <- listToMaybe 
+          locatedType <- listToMaybe
               [ locatedType
               | L _ (SigD _ (TypeSig _ identifiers (HsWC _ (HsIB _ locatedType)))) <- hsmodDecls
               , any (`isSameName` T.unpack typeSignatureName) $ fmap unLoc identifiers

src/Development/IDE/Plugin/Completions/Logic.hs

@@ -23,7 +23,6 @@ import Name
 import RdrName
 import Type
 import Packages
-import DynFlags
 #if MIN_GHC_API_VERSION(8,10,0)
 import Predicate (isDictTy)
 import GHC.Platform
@@ -474,9 +473,9 @@ getCompletions ideOpts CC { allModNamesAsNS, unqualCompls, qualCompls, importabl
 -- The supported languages and extensions
 languagesAndExts :: [T.Text]
 #if MIN_GHC_API_VERSION(8,10,0)
-languagesAndExts = map T.pack $ DynFlags.supportedLanguagesAndExtensions ( PlatformMini ArchUnknown OSUnknown )
+languagesAndExts = map T.pack $ GHC.supportedLanguagesAndExtensions ( PlatformMini ArchUnknown OSUnknown )
 #else
-languagesAndExts = map T.pack DynFlags.supportedLanguagesAndExtensions
+languagesAndExts = map T.pack GHC.supportedLanguagesAndExtensions
 #endif
 
 -- ---------------------------------------------------------------------

src/Development/IDE/Spans/Common.hs

@@ -26,7 +26,6 @@ import GHC.Generics
 
 import GHC
 import Outputable hiding ((<>))
-import DynFlags
 import ConLike
 import DataCon
 import Var
@@ -34,6 +33,7 @@ import NameEnv
 
 import qualified Documentation.Haddock.Parser as H
 import qualified Documentation.Haddock.Types as H
+import Development.IDE.GHC.Compat
 import Development.IDE.GHC.Orphans ()
 
 type DocMap = NameEnv SpanDoc