diff --git a/cabal.project b/cabal.project index 7cc8c97d36..795fac89f9 100644 --- a/cabal.project +++ b/cabal.project @@ -4,8 +4,8 @@ packages: source-repository-package type: git - location: https://github.com/jneira/cabal-helper.git - tag: ffb1f57a5ffc6b7ac3c46a9974c4420a6d2bb9b2 + location: https://github.com/DanielG/cabal-helper.git + tag: a18bbb2af92e9b4337e7f930cb80754f2408bcfd tests: true documentation: false diff --git a/exe/Main.hs b/exe/Main.hs index db2c707dc3..02d865b672 100644 --- a/exe/Main.hs +++ b/exe/Main.hs @@ -1,5 +1,7 @@ -- Copyright (c) 2019 The DAML Authors. All rights reserved. -- SPDX-License-Identifier: Apache-2.0 +{-# LANGUAGE CPP #-} -- To get precise GHC version +{-# LANGUAGE TemplateHaskell #-} {-# OPTIONS_GHC -Wno-dodgy-imports #-} -- GHC no longer exports def in GHC 8.6 and above {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE OverloadedStrings #-} @@ -28,6 +30,7 @@ import qualified Data.Map.Strict as Map import Data.Maybe import qualified Data.Text as T import qualified Data.Text.IO as T +import Data.Time.Clock (UTCTime) -- import Data.Version -- import Development.GitRev import Development.IDE.Core.Debouncer @@ -50,7 +53,7 @@ import DynFlags (gopt_set, gopt_unset, updOptLevel) import DynFlags (PackageFlag(..), PackageArg(..)) import GHC hiding (def) --- import qualified GHC.Paths +import GHC.Check (runTimeVersion, compileTimeVersionFromLibdir) -- import GhcMonad import HIE.Bios.Cradle import HIE.Bios.Environment (addCmdOpts) @@ -243,10 +246,10 @@ showEvent lock (EventFileDiagnostics (toNormalizedFilePath' -> file) diags) = showEvent lock e = withLock lock $ print e -cradleToSessionOpts :: Lock -> Cradle a -> FilePath -> IO ComponentOptions -cradleToSessionOpts lock cradle file = do +cradleToSessionOpts :: Cradle a -> FilePath -> IO ComponentOptions +cradleToSessionOpts cradle file = do let showLine s = putStrLn ("> " ++ s) - cradleRes <- withLock lock $ mask $ \_ -> runCradle (cradleOptsProg cradle) showLine file + cradleRes <- runCradle (cradleOptsProg cradle) showLine file opts <- case cradleRes of CradleSuccess r -> pure r CradleFail err -> throwIO err @@ -271,7 +274,7 @@ targetToFile :: [FilePath] -> TargetId -> IO [NormalizedFilePath] targetToFile is (TargetModule mod) = do let fps = [i (moduleNameSlashes mod) -<.> ext | ext <- exts, i <- is ] exts = ["hs", "hs-boot", "lhs"] - mapM (fmap (toNormalizedFilePath') . canonicalizePath) fps + mapM (fmap toNormalizedFilePath' . canonicalizePath) fps targetToFile _ (TargetFile f _) = do f' <- canonicalizePath f return [(toNormalizedFilePath' f')] @@ -288,6 +291,7 @@ loadSession dir = liftIO $ do hscEnvs <- newVar Map.empty -- Mapping from a filepath to HscEnv fileToFlags <- newVar Map.empty + -- This caches the mapping from Mod.hs -> hie.yaml cradleLoc <- memoIO $ \v -> do res <- findCradle v @@ -301,11 +305,12 @@ loadSession dir = liftIO $ do -- If the hieYaml file already has an HscEnv, the new component is -- combined with the components in the old HscEnv into a new HscEnv -- which contains both. - packageSetup <- return $ \(hieYaml, opts) -> do + packageSetup <- return $ \(hieYaml, cfp, opts) -> do -- Parse DynFlags for the newly discovered component hscEnv <- emptyHscEnv (df, targets) <- evalGhcEnv hscEnv $ do setOptions opts (hsc_dflags hscEnv) + dep_info <- getDependencyInfo (componentDependencies opts) -- Now lookup to see whether we are combining with an exisiting HscEnv -- or making a new one. The lookup returns the HscEnv and a list of -- information about other components loaded into the HscEnv @@ -318,13 +323,13 @@ loadSession dir = liftIO $ do -- We will modify the unitId and DynFlags used for -- compilation but these are the true source of -- information. - new_deps = (thisInstalledUnitId df, df, targets) : maybe [] snd oldDeps + new_deps = (thisInstalledUnitId df, df, targets, cfp, dep_info) : maybe [] snd oldDeps -- Get all the unit-ids for things in this component - inplace = map (\(a, _, _) -> a) new_deps + inplace = map (\(a, _, _, _, _) -> a) new_deps -- Remove all inplace dependencies from package flags for -- components in this HscEnv - rearrange (uid, (df, uids), ts) = (uid, (df, uids, ts)) - do_one (uid,df, ts) = rearrange (uid, removeInplacePackages inplace df, ts) + rearrange (uid, (df, uids), ts, cfp, di) = (uid, (df, uids, ts, cfp, di)) + do_one (uid,df, ts, cfp, di) = rearrange (uid, removeInplacePackages inplace df, ts, cfp, di) -- All deps, but without any packages which are also loaded -- into memory new_deps' = map do_one new_deps @@ -352,29 +357,37 @@ loadSession dir = liftIO $ do pure (Map.insert hieYaml (newHscEnv, new_deps) m, (newHscEnv, head new_deps', tail new_deps')) - session <- return $ \(hieYaml, opts) -> do - (hscEnv, new, old_deps) <- packageSetup (hieYaml, opts) + session <- return $ \(hieYaml, cfp, opts) -> do + (hscEnv, new, old_deps) <- packageSetup (hieYaml, cfp, opts) -- TODO Handle the case where there is no hie.yaml -- Make a map from unit-id to DynFlags, this is used when trying to -- resolve imports. - let uids = map (\(iuid, (df, _uis, _targets)) -> (iuid, df)) (new : old_deps) + let uids = map (\(iuid, (df, _uis, _targets, _cfp, _di)) -> (iuid, df)) (new : old_deps) -- For each component, now make a new HscEnvEq which contains the -- HscEnv for the hie.yaml file but the DynFlags for that component -- -- Then look at the targets for each component and create a map -- from FilePath to the HscEnv - let new_cache (_iuid, (df, _uis, targets)) = do + let new_cache (_iuid, (df, _uis, targets, cfp, di)) = do let hscEnv' = hscEnv { hsc_dflags = df , hsc_IC = (hsc_IC hscEnv) { ic_dflags = df } } - res <- newHscEnvEq hscEnv' uids + versionMismatch <- evalGhcEnv hscEnv' checkGhcVersion + henv <- case versionMismatch of + Just mismatch -> return mismatch + Nothing -> newHscEnvEq hscEnv' uids + let res = (henv, di) + print res let is = importPaths df ctargets <- concatMapM (targetToFile is . targetId) targets + -- A special target for the file which caused this wonderful + -- component to be created. + let special_target = (cfp, res) --pprTraceM "TARGETS" (ppr (map (text . show) ctargets)) let xs = map (,res) ctargets - return (xs, res) + return (special_target:xs, res) -- New HscEnv for the component in question (cs, res) <- new_cache new @@ -382,7 +395,8 @@ loadSession dir = liftIO $ do -- which now uses the same EPS and so on cached_targets <- concatMapM (fmap fst . new_cache) old_deps modifyVar_ fileToFlags $ \var -> do - pure $ Map.insert hieYaml (HM.fromList (cs ++ cached_targets))var + pure $ Map.insert hieYaml (HM.fromList (cs ++ cached_targets)) var + return res lock <- newLock @@ -390,24 +404,59 @@ loadSession dir = liftIO $ do -- This caches the mapping from hie.yaml + Mod.hs -> [String] sessionOpts <- return $ \(hieYaml, file) -> do + + fm <- readVar fileToFlags let mv = Map.lookup hieYaml fm let v = fromMaybe HM.empty mv cfp <- liftIO $ canonicalizePath file + case HM.lookup (toNormalizedFilePath' cfp) v of + Just (_, old_di) -> do + deps_ok <- checkDependencyInfo old_di + unless deps_ok $ do + modifyVar_ fileToFlags (const (return Map.empty)) + -- Keep the same name cache + modifyVar_ hscEnvs (return . Map.adjust (\(h, _) -> (h, [])) hieYaml ) + Nothing -> return () -- We sort so exact matches come first. case HM.lookup (toNormalizedFilePath' cfp) v of Just opts -> do --putStrLn $ "Cached component of " <> show file - pure opts + pure (fst opts) Nothing-> do - putStrLn $ "Shelling out to cabal " <> show file - cradle <- maybe (loadImplicitCradle $ addTrailingPathSeparator dir) loadCradle hieYaml - opts <- cradleToSessionOpts cradle_lock cradle file - print opts - session (hieYaml, opts) - return $ \file -> liftIO $ withLock lock $ do - hieYaml <- cradleLoc file - sessionOpts (hieYaml, file) + finished_barrier <- newBarrier + -- fork a new thread here which won't be killed by shake + -- throwing an async exception + void $ forkIO $ withLock cradle_lock $ do + putStrLn $ "Shelling out to cabal " <> show file + cradle <- maybe (loadImplicitCradle $ addTrailingPathSeparator dir) loadCradle hieYaml + opts <- cradleToSessionOpts cradle cfp + print opts + res <- fst <$> session (hieYaml, toNormalizedFilePath' cfp, opts) + signalBarrier finished_barrier res + waitBarrier finished_barrier + return $ \file -> liftIO $ mask_ $ withLock lock $ do + hieYaml <- cradleLoc file + sessionOpts (hieYaml, file) + +checkDependencyInfo :: Map.Map FilePath (Maybe UTCTime) -> IO Bool +checkDependencyInfo old_di = do + di <- getDependencyInfo (Map.keys old_di) + return (di == old_di) + + + +getDependencyInfo :: [FilePath] -> IO (Map.Map FilePath (Maybe UTCTime)) +getDependencyInfo fs = Map.fromList <$> mapM do_one fs + + where + do_one fp = do + exists <- IO.doesFileExist fp + if exists + then do + mtime <- getModificationTime fp + return (fp, Just mtime) + else return (fp, Nothing) -- This function removes all the -package flags which refer to packages we -- are going to deal with ourselves. For example, if a executable depends @@ -497,3 +546,13 @@ getCacheDir opts = IO.getXdgDirectory IO.XdgCache (cacheDir opts_hash) -- Prefix for the cache path cacheDir :: String cacheDir = "ghcide" + +compileTimeGhcVersion :: Version +compileTimeGhcVersion = $$(compileTimeVersionFromLibdir getLibdir) + +checkGhcVersion :: Ghc (Maybe HscEnvEq) +checkGhcVersion = do + v <- runTimeVersion + return $ if v == Just compileTimeGhcVersion + then Nothing + else Just GhcVersionMismatch {compileTime = compileTimeGhcVersion, runTime = v} diff --git a/ghcide b/ghcide index 2521f7e2ec..74311d255c 160000 --- a/ghcide +++ b/ghcide @@ -1 +1 @@ -Subproject commit 2521f7e2ece1ade21b88aa543ad154a23119d990 +Subproject commit 74311d255cc4a804de6ec69e6db4c13851c108f1 diff --git a/haskell-language-server.cabal b/haskell-language-server.cabal index 5d094f249e..23731e1850 100644 --- a/haskell-language-server.cabal +++ b/haskell-language-server.cabal @@ -133,6 +133,7 @@ executable haskell-language-server -- which works for now. , ghc -------------------------------------------------------------- + , ghc-check , ghc-paths , ghcide , gitrev @@ -144,6 +145,7 @@ executable haskell-language-server , optparse-applicative , shake >= 0.17.5 , text + , time , unordered-containers default-language: Haskell2010 diff --git a/stack-8.6.4.yaml b/stack-8.6.4.yaml index 149811d92a..cb1e958da5 100644 --- a/stack-8.6.4.yaml +++ b/stack-8.6.4.yaml @@ -9,8 +9,8 @@ extra-deps: - butcher-1.3.2.1 - bytestring-trie-0.2.5.0 # - cabal-helper-1.0.0.0 -- github: jneira/cabal-helper - commit: ffb1f57a5ffc6b7ac3c46a9974c4420a6d2bb9b2 +- github: DanielG/cabal-helper + commit: a18bbb2af92e9b4337e7f930cb80754f2408bcfd - cabal-plan-0.5.0.0 - constrained-dynamic-0.1.0.0 # - ghcide-0.1.0 @@ -30,7 +30,7 @@ extra-deps: - hlint-2.2.8 - hoogle-5.0.17.11 - hsimport-0.11.0 -- lsp-test-0.10.1.0 +- lsp-test-0.10.2.0 - monad-dijkstra-0.1.1.2 - monad-memo-0.4.1 - multistate-0.8.0.1 diff --git a/stack-8.6.5.yaml b/stack-8.6.5.yaml index 434ba1c60d..5693be1e1f 100644 --- a/stack-8.6.5.yaml +++ b/stack-8.6.5.yaml @@ -8,8 +8,8 @@ extra-deps: - ansi-terminal-0.10.2 - base-compat-0.11.0 # - cabal-helper-1.0.0.0 -- github: jneira/cabal-helper - commit: ffb1f57a5ffc6b7ac3c46a9974c4420a6d2bb9b2 +- github: DanielG/cabal-helper + commit: a18bbb2af92e9b4337e7f930cb80754f2408bcfd - cabal-plan-0.6.2.0 - clock-0.7.2 - floskell-0.10.2 @@ -22,7 +22,7 @@ extra-deps: - haskell-lsp-types-0.21.0.0 - hie-bios-0.4.0 - indexed-profunctors-0.1 -- lsp-test-0.10.1.0 +- lsp-test-0.10.2.0 - monad-dijkstra-0.1.1.2 - optics-core-0.2 - optparse-applicative-0.15.1.0 diff --git a/stack-8.8.2.yaml b/stack-8.8.2.yaml index e12f73c09a..19cbce6b7b 100644 --- a/stack-8.8.2.yaml +++ b/stack-8.8.2.yaml @@ -8,8 +8,8 @@ extra-deps: - apply-refact-0.7.0.0 - bytestring-trie-0.2.5.0 # - cabal-helper-1.0.0.0 -- github: jneira/cabal-helper - commit: ffb1f57a5ffc6b7ac3c46a9974c4420a6d2bb9b2 +- github: DanielG/cabal-helper + commit: a18bbb2af92e9b4337e7f930cb80754f2408bcfd - clock-0.7.2 - constrained-dynamic-0.1.0.0 - floskell-0.10.2 @@ -25,6 +25,7 @@ extra-deps: - hoogle-5.0.17.11 - hsimport-0.11.0 - ilist-0.3.1.0 +- lsp-test-0.10.2.0 - monad-dijkstra-0.1.1.2 - semigroups-0.18.5 - temporary-1.2.1.1 diff --git a/stack-8.8.3.yaml b/stack-8.8.3.yaml index 36a0d30057..d4588b9e04 100644 --- a/stack-8.8.3.yaml +++ b/stack-8.8.3.yaml @@ -8,8 +8,8 @@ extra-deps: - apply-refact-0.7.0.0 - bytestring-trie-0.2.5.0 # - cabal-helper-1.0.0.0 -- github: jneira/cabal-helper - commit: ffb1f57a5ffc6b7ac3c46a9974c4420a6d2bb9b2 +- github: DanielG/cabal-helper + commit: a18bbb2af92e9b4337e7f930cb80754f2408bcfd - clock-0.7.2 - constrained-dynamic-0.1.0.0 - floskell-0.10.2 @@ -25,6 +25,7 @@ extra-deps: - hoogle-5.0.17.11 - hsimport-0.11.0 - ilist-0.3.1.0 +- lsp-test-0.10.2.0 - monad-dijkstra-0.1.1.2 - semigroups-0.18.5 - temporary-1.2.1.1 diff --git a/stack.yaml b/stack.yaml index 4e25ec8d2b..8c490783b2 100644 --- a/stack.yaml +++ b/stack.yaml @@ -8,8 +8,8 @@ extra-deps: - ansi-terminal-0.10.2 - base-compat-0.11.0 # - cabal-helper-1.0.0.0 -- github: jneira/cabal-helper - commit: ffb1f57a5ffc6b7ac3c46a9974c4420a6d2bb9b2 +- github: DanielG/cabal-helper + commit: a18bbb2af92e9b4337e7f930cb80754f2408bcfd - cabal-plan-0.6.2.0 - clock-0.7.2 - floskell-0.10.2 @@ -22,7 +22,7 @@ extra-deps: - haskell-lsp-types-0.21.0.0 - hie-bios-0.4.0 - indexed-profunctors-0.1 -- lsp-test-0.10.1.0 +- lsp-test-0.10.2.0 - monad-dijkstra-0.1.1.2 - optics-core-0.2 - optparse-applicative-0.15.1.0