From 944d6f2875145bde837add46fd37d305adb14669 Mon Sep 17 00:00:00 2001 From: Moritz Kiefer Date: Sat, 25 Jan 2020 18:13:56 +0100 Subject: [PATCH 1/5] First attempt at multi component support MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit This implements multi-component using separate HscEnv’s which is not great but semes to work somehow. The biggest issue atm is files it `autogen` directories which need to be explicitly specified in hie.yaml which is rather annoying. We need to find some solution for that and stop spinning up one HscEnv per component before merging this. --- exe/Main.hs | 34 +++++++++++++++++++++++++--------- ghcide.cabal | 2 +- hie.yaml | 9 ++++++++- stack.yaml | 3 ++- 4 files changed, 36 insertions(+), 12 deletions(-) diff --git a/exe/Main.hs b/exe/Main.hs index aa574b4b8..3bd97e704 100644 --- a/exe/Main.hs +++ b/exe/Main.hs @@ -1,14 +1,17 @@ -- Copyright (c) 2019 The DAML Authors. All rights reserved. -- SPDX-License-Identifier: Apache-2.0 {-# OPTIONS_GHC -Wno-dodgy-imports #-} -- GHC no longer exports def in GHC 8.6 and above +{-# OPTIONS_GHC -Wno-orphans #-} {-# LANGUAGE CPP #-} -- To get precise GHC version {-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE StandaloneDeriving #-} module Main(main) where import Arguments import Data.Maybe import Data.List.Extra +import Data.Void import System.FilePath import Control.Concurrent.Extra import Control.Exception @@ -125,7 +128,7 @@ main = do cradle <- maybe (loadImplicitCradle $ addTrailingPathSeparator dir) loadCradle x when (isNothing x) $ print cradle putStrLn $ "\nStep 4/6, Cradle " ++ show i ++ "/" ++ show n ++ ": Loading GHC Session" - cradleToSession cradle + optsToSession =<< cradleToSessionOpts cradle "" putStrLn "\nStep 5/6: Initializing the IDE" vfs <- makeVFSHandle @@ -175,15 +178,19 @@ showEvent lock (EventFileDiagnostics (toNormalizedFilePath -> file) diags) = showEvent lock e = withLock lock $ print e -cradleToSession :: Cradle -> IO HscEnvEq -cradleToSession cradle = do - cradleRes <- getCompilerOptions "" cradle +cradleToSessionOpts :: Cradle Void -> FilePath -> IO ComponentOptions +cradleToSessionOpts cradle file = do + cradleRes <- getCompilerOptions file cradle opts <- case cradleRes of CradleSuccess r -> pure r CradleFail err -> throwIO err -- TODO Rather than failing here, we should ignore any files that use this cradle. -- That will require some more changes. CradleNone -> fail "'none' cradle is not yet supported" + pure opts + +optsToSession :: ComponentOptions -> IO HscEnvEq +optsToSession opts = do libdir <- getLibdir env <- runGhc (Just libdir) $ do _targets <- initSession opts @@ -191,9 +198,11 @@ cradleToSession cradle = do initDynLinker env newHscEnvEq env +deriving instance Ord ComponentOptions loadSession :: FilePath -> IO (FilePath -> Action HscEnvEq) loadSession dir = do + -- This caches the mapping from Mod.hs -> hie.yaml cradleLoc <- memoIO $ \v -> do res <- findCradle v -- Sometimes we get C:, sometimes we get c:, and sometimes we get a relative path @@ -201,11 +210,18 @@ loadSession dir = do -- e.g. see https://github.com/digital-asset/ghcide/issues/126 res' <- traverse makeAbsolute res return $ normalise <$> res' - session <- memoIO $ \file -> do - c <- maybe (loadImplicitCradle $ addTrailingPathSeparator dir) loadCradle file - cradleToSession c - return $ \file -> liftIO $ session =<< cradleLoc file - + -- This caches the mapping from hie.yaml + Mod.hs -> [String] + sessionOpts <- memoIO $ \(hieYaml, file) -> do + print ("getting opts for " <> show (hieYaml, file)) + cradle <- maybe (loadImplicitCradle $ addTrailingPathSeparator dir) loadCradle hieYaml + cradleToSessionOpts cradle file + session <- memoIO $ \opts -> do + putStrLn $ "setting up opts for " <> show opts + optsToSession opts + return $ \file -> liftIO $ do + hieYaml <- cradleLoc file + opts <- sessionOpts (hieYaml, file) + session opts -- | Memoize an IO function, with the characteristics: -- diff --git a/ghcide.cabal b/ghcide.cabal index 2c98d2dd2..072582561 100644 --- a/ghcide.cabal +++ b/ghcide.cabal @@ -143,7 +143,7 @@ library executable ghcide-test-preprocessor default-language: Haskell2010 hs-source-dirs: test/preprocessor - ghc-options: -Wall + ghc-options: -Wall -Wno-name-shadowing main-is: Main.hs build-depends: base == 4.* diff --git a/hie.yaml b/hie.yaml index 1f9f2f0d7..b6d409dee 100644 --- a/hie.yaml +++ b/hie.yaml @@ -1 +1,8 @@ -cradle: {stack: {component: "ghcide:lib"}} +cradle: + stack: + - path: "./src" + component: "ghcide:lib" + - path: "./exe" + component: "ghcide:exe:ghcide" + - path: ".stack-work/dist/x86_64-linux/Cabal-2.4.0.1/build/ghcide/autogen" + component: "ghcide:exe:ghcide" diff --git a/stack.yaml b/stack.yaml index 53596f176..4e92bc121 100644 --- a/stack.yaml +++ b/stack.yaml @@ -5,11 +5,12 @@ extra-deps: - haskell-lsp-0.19.0.0 - haskell-lsp-types-0.19.0.0 - lsp-test-0.10.0.0 -- hie-bios-0.3.2 - fuzzy-0.1.0.0 - regex-pcre-builtin-0.95.1.1.8.43 - regex-base-0.94.0.0 - regex-tdfa-1.3.1.0 - parser-combinators-1.2.1 +- git: https://github.com/mpickering/hie-bios.git + commit: d9f602326526ded2bba4ae07d4125b10c6f66ffa nix: packages: [zlib] From e18539388a06ee2a944e777cf1615405c4029547 Mon Sep 17 00:00:00 2001 From: Moritz Kiefer Date: Sun, 26 Jan 2020 10:51:20 +0100 Subject: [PATCH 2/5] Get the terminal test thingy to work with multicradles --- exe/Main.hs | 27 ++++++--------------------- hie.yaml | 2 ++ 2 files changed, 8 insertions(+), 21 deletions(-) diff --git a/exe/Main.hs b/exe/Main.hs index 3bd97e704..e53d8567f 100644 --- a/exe/Main.hs +++ b/exe/Main.hs @@ -122,24 +122,12 @@ main = do let ucradles = nubOrd cradles let n = length ucradles putStrLn $ "Found " ++ show n ++ " cradle" ++ ['s' | n /= 1] - sessions <- forM (zipFrom (1 :: Int) ucradles) $ \(i, x) -> do - let msg = maybe ("Implicit cradle for " ++ dir) ("Loading " ++) x - putStrLn $ "\nStep 3/6, Cradle " ++ show i ++ "/" ++ show n ++ ": " ++ msg - cradle <- maybe (loadImplicitCradle $ addTrailingPathSeparator dir) loadCradle x - when (isNothing x) $ print cradle - putStrLn $ "\nStep 4/6, Cradle " ++ show i ++ "/" ++ show n ++ ": Loading GHC Session" - optsToSession =<< cradleToSessionOpts cradle "" - - putStrLn "\nStep 5/6: Initializing the IDE" + putStrLn "\nStep 3/6: Initializing the IDE" vfs <- makeVFSHandle - let cradlesToSessions = Map.fromList $ zip ucradles sessions - let filesToCradles = Map.fromList $ zip files cradles - let grab file = fromMaybe (head sessions) $ do - cradle <- Map.lookup file filesToCradles - Map.lookup cradle cradlesToSessions - ide <- initialise def mainRule (pure $ IdInt 0) (showEvent lock) (logger Info) (defaultIdeOptions $ return $ return . grab) vfs - - putStrLn "\nStep 6/6: Type checking the files" + grab <- loadSession dir + ide <- initialise def mainRule (pure $ IdInt 0) (showEvent lock) (logger Info) (defaultIdeOptions $ return grab) vfs + + putStrLn "\nStep 4/6: Type checking the files" setFilesOfInterest ide $ Set.fromList $ map toNormalizedFilePath files results <- runActionSync ide $ uses TypeCheck $ map toNormalizedFilePath files let (worked, failed) = partition fst $ zip (map isJust results) files @@ -212,12 +200,9 @@ loadSession dir = do return $ normalise <$> res' -- This caches the mapping from hie.yaml + Mod.hs -> [String] sessionOpts <- memoIO $ \(hieYaml, file) -> do - print ("getting opts for " <> show (hieYaml, file)) cradle <- maybe (loadImplicitCradle $ addTrailingPathSeparator dir) loadCradle hieYaml cradleToSessionOpts cradle file - session <- memoIO $ \opts -> do - putStrLn $ "setting up opts for " <> show opts - optsToSession opts + session <- memoIO optsToSession return $ \file -> liftIO $ do hieYaml <- cradleLoc file opts <- sessionOpts (hieYaml, file) diff --git a/hie.yaml b/hie.yaml index b6d409dee..1bf72796b 100644 --- a/hie.yaml +++ b/hie.yaml @@ -4,5 +4,7 @@ cradle: component: "ghcide:lib" - path: "./exe" component: "ghcide:exe:ghcide" + - path: "./test" + component: "ghcide:test:ghcide-tests" - path: ".stack-work/dist/x86_64-linux/Cabal-2.4.0.1/build/ghcide/autogen" component: "ghcide:exe:ghcide" From a3363598000f43e4bb47f3512bd8c378daae2336 Mon Sep 17 00:00:00 2001 From: Moritz Kiefer Date: Sun, 26 Jan 2020 12:43:11 +0100 Subject: [PATCH 3/5] Split up initialization of HscEnv into package setup and rest --- exe/Main.hs | 34 +++++++++++++++++++++++++++++----- 1 file changed, 29 insertions(+), 5 deletions(-) diff --git a/exe/Main.hs b/exe/Main.hs index e53d8567f..96b844d51 100644 --- a/exe/Main.hs +++ b/exe/Main.hs @@ -50,6 +50,9 @@ import Development.Shake (Action, action) import qualified Data.Set as Set import qualified Data.Map.Strict as Map +import GhcMonad +import HscTypes (HscEnv(..), ic_dflags) +import DynFlags (parseDynamicFlagsFull, flagsPackage, flagsDynamic) import GHC hiding (def) import qualified GHC.Paths @@ -177,13 +180,34 @@ cradleToSessionOpts cradle file = do CradleNone -> fail "'none' cradle is not yet supported" pure opts -optsToSession :: ComponentOptions -> IO HscEnvEq -optsToSession opts = do +emptyHscEnv :: IO HscEnv +emptyHscEnv = do libdir <- getLibdir - env <- runGhc (Just libdir) $ do - _targets <- initSession opts - getSession + env <- runGhc (Just libdir) getSession initDynLinker env + pure env + +addPackageOpts :: HscEnv -> ComponentOptions -> IO HscEnv +addPackageOpts hscEnv opts = do + runGhcEnv hscEnv $ do + df <- getSessionDynFlags + (df', _, _) <- parseDynamicFlagsFull flagsPackage True df (map noLoc $ componentOptions opts) + _targets <- setSessionDynFlags df' + getSession + +tweakHscEnv :: HscEnv -> ComponentOptions -> IO HscEnv +tweakHscEnv hscEnv opts = do + runGhcEnv hscEnv $ do + df <- getSessionDynFlags + (df', _, _) <- parseDynamicFlagsFull flagsDynamic True df (map noLoc $ componentOptions opts) + modifySession $ \h -> h { hsc_dflags = df', hsc_IC = (hsc_IC h) { ic_dflags = df' } } + getSession + +optsToSession :: ComponentOptions -> IO HscEnvEq +optsToSession opts = do + env <- emptyHscEnv + env <- addPackageOpts env opts + env <- tweakHscEnv env opts newHscEnvEq env deriving instance Ord ComponentOptions From 83c35b8bef23ac05e74595678642d51eba3e1f84 Mon Sep 17 00:00:00 2001 From: Moritz Kiefer Date: Sun, 26 Jan 2020 13:15:43 +0100 Subject: [PATCH 4/5] Share HscEnv --- exe/Main.hs | 26 +++++++++++++++++--------- 1 file changed, 17 insertions(+), 9 deletions(-) diff --git a/exe/Main.hs b/exe/Main.hs index 96b844d51..b9ed6c45f 100644 --- a/exe/Main.hs +++ b/exe/Main.hs @@ -203,17 +203,11 @@ tweakHscEnv hscEnv opts = do modifySession $ \h -> h { hsc_dflags = df', hsc_IC = (hsc_IC h) { ic_dflags = df' } } getSession -optsToSession :: ComponentOptions -> IO HscEnvEq -optsToSession opts = do - env <- emptyHscEnv - env <- addPackageOpts env opts - env <- tweakHscEnv env opts - newHscEnvEq env - deriving instance Ord ComponentOptions loadSession :: FilePath -> IO (FilePath -> Action HscEnvEq) loadSession dir = do + hscEnvs <- newVar Map.empty -- This caches the mapping from Mod.hs -> hie.yaml cradleLoc <- memoIO $ \v -> do res <- findCradle v @@ -222,15 +216,29 @@ loadSession dir = do -- e.g. see https://github.com/digital-asset/ghcide/issues/126 res' <- traverse makeAbsolute res return $ normalise <$> res' + + packageSetup <- memoIO $ \(hieYaml, opts) -> + modifyVar_ hscEnvs $ \m -> do + oldHscEnv <- case Map.lookup hieYaml m of + Nothing -> emptyHscEnv + Just hscEnv -> pure hscEnv + newHscEnv <- addPackageOpts oldHscEnv opts + pure (Map.insert hieYaml newHscEnv m) + + session <- memoIO $ \(hieYaml, opts) -> do + packageSetup (hieYaml, opts) + hscEnv <- fmap (Map.lookup hieYaml) $ readVar hscEnvs + -- TODO Handle the case where there is no hie.yaml + newHscEnvEq =<< tweakHscEnv (fromJust hscEnv) opts + -- This caches the mapping from hie.yaml + Mod.hs -> [String] sessionOpts <- memoIO $ \(hieYaml, file) -> do cradle <- maybe (loadImplicitCradle $ addTrailingPathSeparator dir) loadCradle hieYaml cradleToSessionOpts cradle file - session <- memoIO optsToSession return $ \file -> liftIO $ do hieYaml <- cradleLoc file opts <- sessionOpts (hieYaml, file) - session opts + session (hieYaml, opts) -- | Memoize an IO function, with the characteristics: -- From 76f9a42280545be809a7dc163dcc2c5de51e726b Mon Sep 17 00:00:00 2001 From: Moritz Kiefer Date: Fri, 31 Jan 2020 09:15:32 +0100 Subject: [PATCH 5/5] avoid shelling out to cabal once per file --- exe/Main.hs | 34 ++++++++++++++++++++++++++++++---- hie.yaml | 6 ++++-- 2 files changed, 34 insertions(+), 6 deletions(-) diff --git a/exe/Main.hs b/exe/Main.hs index b9ed6c45f..48f7b09bb 100644 --- a/exe/Main.hs +++ b/exe/Main.hs @@ -8,6 +8,7 @@ module Main(main) where +import Module import Arguments import Data.Maybe import Data.List.Extra @@ -171,6 +172,7 @@ showEvent lock e = withLock lock $ print e cradleToSessionOpts :: Cradle Void -> FilePath -> IO ComponentOptions cradleToSessionOpts cradle file = do + cradleRes <- getCompilerOptions file cradle opts <- case cradleRes of CradleSuccess r -> pure r @@ -205,9 +207,14 @@ tweakHscEnv hscEnv opts = do deriving instance Ord ComponentOptions +targetToFile :: TargetId -> (NormalizedFilePath, Bool) +targetToFile (TargetModule mod) = (toNormalizedFilePath $ (moduleNameSlashes mod) -<.> "hs", False) +targetToFile (TargetFile f _) = (toNormalizedFilePath f, True) + loadSession :: FilePath -> IO (FilePath -> Action HscEnvEq) loadSession dir = do hscEnvs <- newVar Map.empty + fileToFlags <- newVar [] -- This caches the mapping from Mod.hs -> hie.yaml cradleLoc <- memoIO $ \v -> do res <- findCradle v @@ -217,7 +224,15 @@ loadSession dir = do res' <- traverse makeAbsolute res return $ normalise <$> res' - packageSetup <- memoIO $ \(hieYaml, opts) -> + packageSetup <- memoIO $ \(hieYaml, opts) -> do + hscEnv <- emptyHscEnv + -- TODO This should definitely not call initSession + targets <- runGhcEnv hscEnv $ initSession opts + modifyVar_ fileToFlags $ \var -> do + let xs = map (\target -> (targetToFile $ targetId target,opts)) targets + print (map (fromNormalizedFilePath . fst . fst) xs) + pure $ xs ++ var + -- print (hieYaml, opts) modifyVar_ hscEnvs $ \m -> do oldHscEnv <- case Map.lookup hieYaml m of Nothing -> emptyHscEnv @@ -231,10 +246,21 @@ loadSession dir = do -- TODO Handle the case where there is no hie.yaml newHscEnvEq =<< tweakHscEnv (fromJust hscEnv) opts + lock <- newLock + -- This caches the mapping from hie.yaml + Mod.hs -> [String] - sessionOpts <- memoIO $ \(hieYaml, file) -> do - cradle <- maybe (loadImplicitCradle $ addTrailingPathSeparator dir) loadCradle hieYaml - cradleToSessionOpts cradle file + sessionOpts <- memoIO $ \(hieYaml, file) -> withLock lock $ do + v <- readVar fileToFlags + -- We sort so exact matches come first. + case find (\((f', exact), _) -> fromNormalizedFilePath f' == file || not exact && fromNormalizedFilePath f' `isSuffixOf` file) v of + Just (_, opts) -> do + putStrLn $ "Cached component of " <> show file + pure opts + Nothing-> do + putStrLn $ "Shelling out to cabal " <> show file + cradle <- maybe (loadImplicitCradle $ addTrailingPathSeparator dir) loadCradle hieYaml + opts <- cradleToSessionOpts cradle file + pure opts return $ \file -> liftIO $ do hieYaml <- cradleLoc file opts <- sessionOpts (hieYaml, file) diff --git a/hie.yaml b/hie.yaml index 1bf72796b..1f5848879 100644 --- a/hie.yaml +++ b/hie.yaml @@ -1,10 +1,12 @@ cradle: - stack: + cabal: - path: "./src" - component: "ghcide:lib" + component: "ghcide:lib:ghcide" - path: "./exe" component: "ghcide:exe:ghcide" - path: "./test" component: "ghcide:test:ghcide-tests" + - path: "./test/preprocessor" + component: "ghcide:exe:ghcide-test-preprocessor" - path: ".stack-work/dist/x86_64-linux/Cabal-2.4.0.1/build/ghcide/autogen" component: "ghcide:exe:ghcide"