IDE cleanups and progress towards external usability (#930)

* Remove the requirement for Binary on Shake rules (was not used)

* Add a deriving Show on Event, easier for external integrations

* Rename GeneratePackageState to LoadPackageState and move its fields to the rule, rather than the key

* Inline getPackageState away

* Change to passing a ModRenaming to the package loader. Two reasons:
1) When loading non-DAML things we might want to omit the renaming
2) The type ModRenaming has documentation of semantics, unlike [(String, String)]

compiler/haskell-ide-core/src/Development/IDE/Functions/Compile.hs

@@ -72,7 +72,7 @@ data CompileOpts = CompileOpts
 
   , optPackageDbs :: [FilePath]
   , optHideAllPkgs :: Bool
-  , optPackageImports :: [(String, [(String, String)])]
+  , optPackageImports :: [(String, ModRenaming)]
 
   , optThreads :: Int
   , optShakeProfiling :: Maybe FilePath
@@ -486,7 +486,7 @@ parsePragmasIntoDynFlags fp contents = catchSrcErrors $ do
     (dflags, _, _) <- parseDynamicFilePragma dflags0 opts
     return dflags
 
-generatePackageState :: [FilePath] -> Bool -> [(String, [(String, String)])] -> IO PackageState
+generatePackageState :: [FilePath] -> Bool -> [(String, ModRenaming)] -> IO PackageState
 generatePackageState paths hideAllPkgs pkgImports = do
   let dflags = setPackageImports hideAllPkgs pkgImports $ setPackageDbs paths (defaultDynFlags fakeSettings fakeLlvmConfig)
   (newDynFlags, _) <- initPackages dflags

compiler/haskell-ide-core/src/Development/IDE/State/FileStore.hs

@@ -54,19 +54,16 @@ type instance RuleResult GetFileExists = Bool
 
 data GetFileExists = GetFileExists
     deriving (Eq, Show, Generic)
-instance Binary   GetFileExists
 instance Hashable GetFileExists
 instance NFData   GetFileExists
 
 data GetModificationTime = GetModificationTime
     deriving (Eq, Show, Generic)
-instance Binary   GetModificationTime
 instance Hashable GetModificationTime
 instance NFData   GetModificationTime
 
 data GetFileContents = GetFileContents
     deriving (Eq, Show, Generic)
-instance Binary   GetFileContents
 instance Hashable GetFileContents
 instance NFData   GetFileContents
 

compiler/haskell-ide-core/src/Development/IDE/State/RuleTypes.hs

@@ -17,8 +17,6 @@ import           Development.IDE.Functions.Compile             (TcModuleResult,
 import qualified Development.IDE.Functions.Compile             as Compile
 import           Development.IDE.Functions.FindImports         (Import(..))
 import           Development.IDE.Functions.DependencyInformation
-import           Data.Binary                              (Binary)
-import qualified Data.Binary                              as Binary
 import           Data.Hashable
 import           Data.Typeable
 import           Development.Shake                        hiding (Env, newCache)
@@ -63,7 +61,7 @@ type instance RuleResult GenerateCore = GhcModule
 
 -- | We capture the subset of `DynFlags` that is computed by package initialization in a rule to
 -- make session initialization cheaper by reusing it.
-type instance RuleResult GeneratePackageState = Compile.PackageState
+type instance RuleResult LoadPackageState = Compile.PackageState
 
 -- | Resolve the imports in a module to the list of either external packages or absolute file paths
 -- for modules in the same package.
@@ -77,69 +75,58 @@ type instance RuleResult ReportImportCycles = ()
 
 data OfInterest = OfInterest
     deriving (Eq, Show, Typeable, Generic)
-instance Binary   OfInterest
 instance Hashable OfInterest
 instance NFData   OfInterest
 
 data GetParsedModule = GetParsedModule
     deriving (Eq, Show, Typeable, Generic)
-instance Binary   GetParsedModule
 instance Hashable GetParsedModule
 instance NFData   GetParsedModule
 
 data GetLocatedImports = GetLocatedImports
     deriving (Eq, Show, Typeable, Generic)
-instance Binary   GetLocatedImports
 instance Hashable GetLocatedImports
 instance NFData   GetLocatedImports
 
 data GetDependencyInformation = GetDependencyInformation
     deriving (Eq, Show, Typeable, Generic)
-instance Binary   GetDependencyInformation
 instance Hashable GetDependencyInformation
 instance NFData   GetDependencyInformation
 
 data ReportImportCycles = ReportImportCycles
     deriving (Eq, Show, Typeable, Generic)
-instance Binary   ReportImportCycles
 instance Hashable ReportImportCycles
 instance NFData   ReportImportCycles
 
 data GetDependencies = GetDependencies
     deriving (Eq, Show, Typeable, Generic)
-instance Binary   GetDependencies
 instance Hashable GetDependencies
 instance NFData   GetDependencies
 
 data TypeCheck = TypeCheck
     deriving (Eq, Show, Typeable, Generic)
-instance Binary   TypeCheck
 instance Hashable TypeCheck
 instance NFData   TypeCheck
 
 data LoadPackage = LoadPackage InstalledUnitId
     deriving (Eq, Show, Typeable, Generic)
-instance Binary   LoadPackage
 instance Hashable LoadPackage
 instance NFData   LoadPackage
 
 data GetSpanInfo = GetSpanInfo
     deriving (Eq, Show, Typeable, Generic)
-instance Binary   GetSpanInfo
 instance Hashable GetSpanInfo
 instance NFData   GetSpanInfo
 
 data GenerateCore = GenerateCore
     deriving (Eq, Show, Typeable, Generic)
-instance Binary   GenerateCore
 instance Hashable GenerateCore
 instance NFData   GenerateCore
 
-data GeneratePackageState = GeneratePackageState [FilePath] Bool [(String, [(String, String)])]
+data LoadPackageState = LoadPackageState
     deriving (Eq, Show, Typeable, Generic)
-instance Binary   GeneratePackageState
-instance Hashable GeneratePackageState
-instance NFData   GeneratePackageState
+instance Hashable LoadPackageState
+instance NFData   LoadPackageState
 
 ------------------------------------------------------------
 -- Orphan Instances
@@ -171,10 +158,6 @@ instance NFData SpanInfo where
 instance NFData Import where
   rnf = rwhnf
 
-instance Binary InstalledUnitId where
-  get = fmap stringToInstalledUnitId Binary.get
-  put = Binary.put . installedUnitIdString
-
 instance Hashable InstalledUnitId where
   hashWithSalt salt = hashWithSalt salt . installedUnitIdString
 

compiler/haskell-ide-core/src/Development/IDE/State/Rules.hs

@@ -172,7 +172,7 @@ getParsedModuleRule :: Rules ()
 getParsedModuleRule =
     define $ \GetParsedModule file -> do
         contents <- getFileContents file
-        packageState <- getPackageState
+        packageState <- use_ LoadPackageState ""
         opt <- getOpts
         liftIO $ Compile.parseModule opt packageState file contents
 
@@ -182,7 +182,7 @@ getLocatedImportsRule =
         pm <- use_ GetParsedModule file
         let ms = pm_mod_summary pm
         let imports = ms_textual_imps ms
-        packageState <- getPackageState
+        packageState <- use_ LoadPackageState ""
         opt <- getOpts
         dflags <- liftIO $ Compile.getGhcDynFlags opt pm packageState
         xs <- forM imports $ \(mbPkgName, modName) ->
@@ -204,7 +204,7 @@ rawDependencyInformation f = go (Set.singleton f) Map.empty Map.empty
                   let modGraph' = Map.insert f (Left ModuleParseError) modGraph
                   in go fs modGraph' pkgs
                 Just imports -> do
-                  packageState <- lift getPackageState
+                  packageState <- lift $ use_ LoadPackageState ""
                   opt <- lift getOpts
                   modOrPkgImports <- forM imports $ \imp -> do
                     case imp of
@@ -272,7 +272,7 @@ getSpanInfoRule =
         pm <- use_ GetParsedModule file
         tc <- use_ TypeCheck file
         imports <- use_ GetLocatedImports file
-        packageState <- getPackageState
+        packageState <- use_ LoadPackageState ""
         opt <- getOpts
         x <- liftIO $ Compile.getSrcSpanInfos opt pm packageState (fileImports imports) tc
         return ([], Just x)
@@ -287,7 +287,7 @@ typeCheckRule =
         tms <- uses_ TypeCheck (transitiveModuleDeps deps)
         setPriority PriorityTypeCheck
         us <- getUniqSupply
-        packageState <- getPackageState
+        packageState <- use_ LoadPackageState ""
         opt <- getOpts
         liftIO $ Compile.typecheckModule opt pm packageState us tms lps pm
 
@@ -295,7 +295,7 @@ typeCheckRule =
 loadPackageRule :: Rules ()
 loadPackageRule =
   defineNoFile $ \(LoadPackage pkg) -> do
-      packageState <- getPackageState
+      packageState <- use_ LoadPackageState ""
       opt <- getOpts
       pkgs <- liftIO $ Compile.computePackageDeps opt packageState pkg
       case pkgs of
@@ -319,14 +319,16 @@ generateCoreRule =
         let pm = tm_parsed_module . Compile.tmrModule $ tm
         setPriority PriorityGenerateDalf
         us <- getUniqSupply
-        packageState <- getPackageState
+        packageState <- use_ LoadPackageState ""
         opt <- getOpts
         liftIO $ Compile.compileModule opt pm packageState us tms lps tm
 
-generatePackageStateRule :: Rules ()
-generatePackageStateRule =
-    defineNoFile $ \(GeneratePackageState paths hideAllPkgs pkgImports) -> do
-        liftIO $ Compile.generatePackageState paths hideAllPkgs pkgImports
+loadPackageStateRule :: Rules ()
+loadPackageStateRule =
+    defineNoFile $ \LoadPackageState -> do
+        opts <- envOptions <$> getServiceEnv
+        liftIO $ Compile.generatePackageState
+            (Compile.optPackageDbs opts) (Compile.optHideAllPkgs opts) (Compile.optPackageImports opts)
 
 -- | A rule that wires per-file rules together
 mainRule :: Rules ()
@@ -339,7 +341,7 @@ mainRule = do
     typeCheckRule
     getSpanInfoRule
     generateCoreRule
-    generatePackageStateRule
+    loadPackageStateRule
     loadPackageRule
 
 ------------------------------------------------------------
@@ -347,11 +349,6 @@ mainRule = do
 fileFromParsedModule :: ParsedModule -> IO FilePath
 fileFromParsedModule = pure . ms_hspp_file . pm_mod_summary
 
-getPackageState :: Action PackageState
-getPackageState = do
-  opts <- envOptions <$> getServiceEnv
-  use_ (GeneratePackageState (Compile.optPackageDbs opts) (Compile.optHideAllPkgs opts) (Compile.optPackageImports opts)) ""
-
 fileImports ::
      [(Located ModuleName, Maybe Import)]
   -> [(Located ModuleName, Maybe FilePath)]

compiler/haskell-ide-core/src/Development/IDE/State/Shake.hs

@@ -152,7 +152,11 @@ type IdeResult v = ([FileDiagnostic], Maybe v)
 
 type IdeRule k v =
   ( Shake.RuleResult k ~ v
-  , Shake.ShakeValue k
+  , Show k
+  , Typeable k
+  , NFData k
+  , Hashable k
+  , Eq k
   , Show v
   , Typeable v
   , NFData v
@@ -320,7 +324,12 @@ isBadDependency x
 
 
 newtype Q k = Q (k, FilePath)
-    deriving (Eq,Hashable,Binary,NFData)
+    deriving (Eq,Hashable,NFData)
+
+-- Using Database we don't need Binary instances for keys
+instance Binary (Q k) where
+    put _ = return ()
+    get = fail "Binary.get not defined for type Development.IDE.State.Shake.Q"
 
 instance Show k => Show (Q k) where
     show (Q (k, file)) = show k ++ "; " ++ file

compiler/haskell-ide-core/src/Development/IDE/Types/LSP.hs

@@ -58,3 +58,4 @@ data Event
     | EventFatalError !T.Text
       -- ^ @EventFatalError reason@: A fatal error occurred in the compiler and
       -- the compiler cannot continue.
+      deriving Show

compiler/haskell-ide-core/src/Development/IDE/UtilGHC.hs

@@ -156,12 +156,11 @@ setPackageDbs paths dflags =
         }
     }
 
-setPackageImports :: Bool -> [(String, [(String, String)])] -> DynFlags -> DynFlags
+setPackageImports :: Bool -> [(String, ModRenaming)] -> DynFlags -> DynFlags
 setPackageImports hideAllPkgs pkgImports dflags = dflags {
     packageFlags = packageFlags dflags ++
-        [ExposePackage pkgName (UnitIdArg $ stringToUnitId pkgName)
-          (ModRenaming False [(mkModuleName mod, mkModuleName alias) | (mod, alias) <- aliases])
-        | (pkgName, aliases) <- pkgImports
+        [ExposePackage pkgName (UnitIdArg $ stringToUnitId pkgName) renaming
+        | (pkgName, renaming) <- pkgImports
         ]
     , generalFlags = if hideAllPkgs
                       then Opt_HideAllPackages `EnumSet.insert` generalFlags dflags

daml-foundations/daml-ghc/src/DA/Daml/GHC/Compiler/Options.hs

@@ -22,7 +22,9 @@ import DA.Daml.GHC.Compiler.Preprocessor
 
 import           Control.Monad.Reader
 import qualified Data.List.Extra as List
-import Data.Maybe (fromMaybe)
+import Data.Maybe
+import Data.Tuple.Extra
+import "ghc-lib-parser" DynFlags
 import qualified "ghc-lib" GHC
 import "ghc-lib-parser" Module (moduleNameSlashes)
 import qualified System.Directory as Dir
@@ -71,10 +73,12 @@ toCompileOpts Options{..} =
       , optMbPackageName = optMbPackageName
       , optPackageDbs = optPackageDbs
       , optHideAllPkgs = optHideAllPkgs
-      , optPackageImports = optPackageImports
+      , optPackageImports = map (second toRenaming) optPackageImports
       , optThreads = optThreads
       , optShakeProfiling = optShakeProfiling
       }
+  where
+    toRenaming aliases = ModRenaming False [(GHC.mkModuleName mod, GHC.mkModuleName alias) | (mod, alias) <- aliases]
 
 moduleImportPaths :: GHC.ParsedModule -> [FilePath]
 moduleImportPaths pm =