00d914e · ghcide · git.iko.soy

git.iko.soy/ghcide

Automatically pick up new dependencies (#408)

* Automatically pick up new dependencies hie-bios's componentDependencies returns the dependencies of a cradle that might change the cradle. Add those deps to the shake graph so that the GHC session is newly created whenever they change. For that, add a new rule type, GetHscEnvEq, to cache GHC sessions with the key of GHC options and dependencies. And delete the optGhcSession field from IdeOptions. This is for https://github.com/digital-asset/ghcide/issues/50. hie-bios's componentDependencies can return files that don't exist yet: https://github.com/mpickering/hie-bios/blob/master/src/HIE/Bios/Types.hs#L90-L93. This PR handles changes in the existing dependency files, but doesn't handle newly created dependency files. * address comments * revert hie.yaml * address more comments * add test * make direct cradles work; and use direct cradle in test

commit00d914efa71de08ae11e4268112817cecdf439e9 authorJinwoo Lee <jinwoo@google.com> dateMon 17 Feb 2020, 01:33 (7 years ago) parent2ae46ae

5 files changed+128−30

compare with master

unifiedsplit

exe/Main.hs+70−22 ghcide.cabal+4 src/Development/IDE/Core/Rules.hs+2−2 src/Development/IDE/Types/Options.hs+3−5 test/exe/Main.hs+49−1

exe/Main.hs+70−22

@@ -3,14 +3,19 @@

33{-# OPTIONS_GHC -Wno-dodgy-imports #-} -- GHC no longer exports def in GHC 8.6 and above

44{-# LANGUAGE CPP #-} -- To get precise GHC version

55{-# LANGUAGE TemplateHaskell #-}

6+{-# LANGUAGE TypeFamilies #-}

78module Main(main) where

910import Arguments

11+import Data.Binary (Binary)

12+import Data.Dynamic (Typeable)

13+import Data.Hashable (Hashable)

1014import Data.Maybe

1115import Data.List.Extra

1216import System.FilePath

1317import Control.Concurrent.Extra

18+import Control.DeepSeq (NFData)

1419import Control.Exception

1520import Control.Monad.Extra

1621import Control.Monad.IO.Class

@@ -39,20 +44,22 @@ import Language.Haskell.LSP.Types (LspId(IdInt))

3944import Linker

4045import Data.Version

4146import Development.IDE.LSP.LanguageServer

42−import System.Directory.Extra as IO

47+import qualified System.Directory.Extra as IO

4348import System.Environment

4449import System.IO

4550import System.Exit

4651import Paths_ghcide

4752import Development.GitRev

48−import Development.Shake (Action, action)

53+import Development.Shake (Action, RuleResult, Rules, action, doesFileExist, need)

4954import qualified Data.HashSet as HashSet

5055import qualified Data.Map.Strict as Map

5156

5257import GHC hiding (def)

58+import GHC.Generics (Generic)

5359import qualified GHC.Paths

5460

5561import HIE.Bios

62+import HIE.Bios.Cradle

5663import HIE.Bios.Types

5764

5865-- Set the GHC libdir to the nix libdir if it's present.

@@ -84,9 +91,9 @@ main = do

8491 let logger p = Logger $ \pri msg -> when (pri >= p) $ withLock lock $

8592 T.putStrLn $ T.pack ("[" ++ upper (show pri) ++ "] ") <> msg

8693

87− whenJust argsCwd setCurrentDirectory

94+ whenJust argsCwd IO.setCurrentDirectory

8895

89− dir <- getCurrentDirectory

96+ dir <- IO.getCurrentDirectory

9097

9198 let plugins = Completions.plugin <> CodeAction.plugin

9299 onInitialConfiguration = const $ Right ()

@@ -99,14 +106,13 @@ main = do

99106 runLanguageServer def (pluginHandler plugins) onInitialConfiguration onConfigurationChange $ \getLspId event vfs caps -> do

100107 t <- t

101108 hPutStrLn stderr $ "Started LSP server in " ++ showDuration t

102− -- very important we only call loadSession once, and it's fast, so just do it before starting

103− session <- loadSession dir

104− let options = (defaultIdeOptions $ return session)

109+ let options = (defaultIdeOptions $ loadSession dir)

105110 { optReportProgress = clientSupportsProgress caps

106111 , optShakeProfiling = argsShakeProfiling

107112 }

108113 debouncer <- newAsyncDebouncer

109− initialise caps (mainRule >> pluginRules plugins >> action kick) getLspId event (logger minBound) debouncer options vfs

114+ initialise caps (loadGhcSessionIO >> mainRule >> pluginRules plugins >> action kick)

115+ getLspId event (logger minBound) debouncer options vfs

110116 else do

111117 putStrLn $ "Ghcide setup tester in " ++ dir ++ "."

112118 putStrLn "Report bugs at https://github.com/digital-asset/ghcide/issues"

@@ -114,7 +120,7 @@ main = do

114120 putStrLn $ "\nStep 1/6: Finding files to test in " ++ dir

115121 files <- expandFiles (argFiles ++ ["." | null argFiles])

116122 -- LSP works with absolute file paths, so try and behave similarly

117− files <- nubOrd <$> mapM canonicalizePath files

123+ files <- nubOrd <$> mapM IO.canonicalizePath files

118124 putStrLn $ "Found " ++ show (length files) ++ " files"

119125

120126 putStrLn "\nStep 2/6: Looking for hie.yaml files that control setup"

@@ -128,7 +134,8 @@ main = do

128134 cradle <- maybe (loadImplicitCradle $ addTrailingPathSeparator dir) loadCradle x

129135 when (isNothing x) $ print cradle

130136 putStrLn $ "\nStep 4/6, Cradle " ++ show i ++ "/" ++ show n ++ ": Loading GHC Session"

131− cradleToSession cradle

137+ opts <- getComponentOptions cradle

138+ createSession opts

132139

133140 putStrLn "\nStep 5/6: Initializing the IDE"

134141 vfs <- makeVFSHandle

@@ -141,7 +148,7 @@ main = do

141148 let options =

142149 (defaultIdeOptions $ return $ return . grab)

143150 { optShakeProfiling = argsShakeProfiling }

144− ide <- initialise def mainRule (pure $ IdInt 0) (showEvent lock) (logger Info) noopDebouncer options vfs

151+ ide <- initialise def (loadGhcSessionIO >> mainRule) (pure $ IdInt 0) (showEvent lock) (logger Info) noopDebouncer options vfs

145152

146153 putStrLn "\nStep 6/6: Type checking the files"

147154 setFilesOfInterest ide $ HashSet.fromList $ map toNormalizedFilePath files

@@ -163,7 +170,7 @@ expandFiles = concatMapM $ \x -> do

163170 let recurse "." = True

164171 recurse x | "." `isPrefixOf` takeFileName x = False -- skip .git etc

165172 recurse x = takeFileName x `notElem` ["dist","dist-newstyle"] -- cabal directories

166− files <- filter (\x -> takeExtension x `elem` [".hs",".lhs"]) <$> listFilesInside (return . recurse) x

173+ files <- filter (\x -> takeExtension x `elem` [".hs",".lhs"]) <$> IO.listFilesInside (return . recurse) x

167174 when (null files) $

168175 fail $ "Couldn't find any .hs/.lhs files inside directory: " ++ x

169176 return files

@@ -182,16 +189,42 @@ showEvent lock (EventFileDiagnostics (toNormalizedFilePath -> file) diags) =

182189showEvent lock e = withLock lock $ print e

183190

184191

185−cradleToSession :: Cradle a -> IO HscEnvEq

186−cradleToSession cradle = do

192+-- Rule type for caching GHC sessions.

193+type instance RuleResult GetHscEnv = HscEnvEq

194+

195+data GetHscEnv = GetHscEnv

196+ { hscenvOptions :: [String] -- componentOptions from hie-bios

197+ , hscenvDependencies :: [FilePath] -- componentDependencies from hie-bios

198+ }

199+ deriving (Eq, Show, Typeable, Generic)

200+instance Hashable GetHscEnv

201+instance NFData GetHscEnv

202+instance Binary GetHscEnv

203+

204+

205+loadGhcSessionIO :: Rules ()

206+loadGhcSessionIO =

207+ -- This rule is for caching the GHC session. E.g., even when the cabal file

208+ -- changed, if the resulting flags did not change, we would continue to use

209+ -- the existing session.

210+ defineNoFile $ \(GetHscEnv opts deps) ->

211+ liftIO $ createSession $ ComponentOptions opts deps

212+

213+

214+getComponentOptions :: Cradle a -> IO ComponentOptions

215+getComponentOptions cradle = do

187216 let showLine s = putStrLn ("> " ++ s)

188217 cradleRes <- runCradle (cradleOptsProg cradle) showLine ""

189− opts <- case cradleRes of

218+ case cradleRes of

190219 CradleSuccess r -> pure r

191220 CradleFail err -> throwIO err

192221 -- TODO Rather than failing here, we should ignore any files that use this cradle.

193222 -- That will require some more changes.

194223 CradleNone -> fail "'none' cradle is not yet supported"

224+

225+

226+createSession :: ComponentOptions -> IO HscEnvEq

227+createSession opts = do

195228 libdir <- getLibdir

196229 env <- runGhc (Just libdir) $ do

197230 _targets <- initSession opts

@@ -200,19 +233,34 @@ cradleToSession cradle = do

200233 newHscEnvEq env

201234

202235

203−loadSession :: FilePath -> IO (FilePath -> Action HscEnvEq)

204−loadSession dir = do

236+cradleToSession :: Maybe FilePath -> Cradle a -> Action HscEnvEq

237+cradleToSession mbYaml cradle = do

238+ cmpOpts <- liftIO $ getComponentOptions cradle

239+ let opts = componentOptions cmpOpts

240+ deps = componentDependencies cmpOpts

241+ deps' = case mbYaml of

242+ -- For direct cradles, the hie.yaml file itself must be watched.

243+ Just yaml | isDirectCradle cradle -> yaml : deps

244+ _ -> deps

245+ existingDeps <- filterM doesFileExist deps'

246+ need existingDeps

247+ useNoFile_ $ GetHscEnv opts deps

248+

249+

250+loadSession :: FilePath -> Action (FilePath -> Action HscEnvEq)

251+loadSession dir = liftIO $ do

205252 cradleLoc <- memoIO $ \v -> do

206253 res <- findCradle v

207254 -- Sometimes we get C:, sometimes we get c:, and sometimes we get a relative path

208255 -- try and normalise that

209256 -- e.g. see https://github.com/digital-asset/ghcide/issues/126

210− res' <- traverse makeAbsolute res

257+ res' <- traverse IO.makeAbsolute res

211258 return $ normalise <$> res'

212− session <- memoIO $ \file -> do

213− c <- maybe (loadImplicitCradle $ addTrailingPathSeparator dir) loadCradle file

214− cradleToSession c

215− return $ \file -> liftIO $ session =<< cradleLoc file

259+ let session :: Maybe FilePath -> Action HscEnvEq

260+ session file = do

261+ c <- liftIO $ maybe (loadImplicitCradle $ addTrailingPathSeparator dir) loadCradle file

262+ cradleToSession file c

263+ return $ \file -> session =<< liftIO (cradleLoc file)

216264

217265

218266-- | Memoize an IO function, with the characteristics:

ghcide.cabal+4

@@ -169,14 +169,17 @@ executable ghcide

169169 build-depends:

170170 hslogger,

171171 base == 4.*,

172+ binary,

172173 containers,

173174 data-default,

175+ deepseq,

174176 directory,

175177 extra,

176178 filepath,

177179 ghc-paths,

178180 ghc,

179181 gitrev,

182+ hashable,

180183 haskell-lsp,

181184 hie-bios >= 0.4.0 && < 0.5,

182185 ghcide,

@@ -189,6 +192,7 @@ executable ghcide

189192 Paths_ghcide

190193

191194 default-extensions:

195+ DeriveGeneric

192196 RecordWildCards

193197 TupleSections

194198 ViewPatterns

src/Development/IDE/Core/Rules.hs+2−2

@@ -11,7 +11,7 @@

1111--

1212module Development.IDE.Core.Rules(

1313 IdeState, GetDependencies(..), GetParsedModule(..), TransitiveDependencies(..),

14− Priority(..),

14+ Priority(..), GhcSessionIO(..), GhcSessionFun(..),

1515 priorityTypeCheck,

1616 priorityGenerateCore,

1717 priorityFilesOfInterest,

@@ -339,7 +339,7 @@ loadGhcSession :: Rules ()

339339loadGhcSession = do

340340 defineNoFile $ \GhcSessionIO -> do

341341 opts <- getIdeOptions

342− liftIO $ GhcSessionFun <$> optGhcSession opts

342+ GhcSessionFun <$> optGhcSession opts

343343 defineEarlyCutoff $ \GhcSession file -> do

344344 GhcSessionFun fun <- useNoFile_ GhcSessionIO

345345 val <- fun $ fromNormalizedFilePath file

src/Development/IDE/Types/Options.hs+3−5

@@ -25,12 +25,10 @@ data IdeOptions = IdeOptions

2525 { optPreprocessor :: GHC.ParsedSource -> IdePreprocessedSource

2626 -- ^ Preprocessor to run over all parsed source trees, generating a list of warnings

2727 -- and a list of errors, along with a new parse tree.

28− , optGhcSession :: IO (FilePath -> Action HscEnvEq)

28+ , optGhcSession :: Action (FilePath -> Action HscEnvEq)

2929 -- ^ Setup a GHC session for a given file, e.g. @Foo.hs@.

30− -- The 'IO' will be called once, then the resulting function will be applied once per file.

30+ -- For the same 'ComponentOptions' from hie-bios, the resulting function will be applied once per file.

3131 -- It is desirable that many files get the same 'HscEnvEq', so that more IDE features work.

32− -- You should not use 'newCacheIO' to get that caching, because of

33− -- https://github.com/ndmitchell/shake/issues/725.

3432 , optPkgLocationOpts :: IdePkgLocationOptions

3533 -- ^ How to locate source and @.hie@ files given a module name.

3634 , optExtensions :: [String]

@@ -73,7 +71,7 @@ clientSupportsProgress :: LSP.ClientCapabilities -> IdeReportProgress

7371clientSupportsProgress caps = IdeReportProgress $ fromMaybe False $

7472 LSP._workDoneProgress =<< LSP._window (caps :: LSP.ClientCapabilities)

7573

76−defaultIdeOptions :: IO (FilePath -> Action HscEnvEq) -> IdeOptions

74+defaultIdeOptions :: Action (FilePath -> Action HscEnvEq) -> IdeOptions

7775defaultIdeOptions session = IdeOptions

7876 {optPreprocessor = IdePreprocessedSource [] []

7977 ,optGhcSession = session

test/exe/Main.hs+49−1

@@ -64,6 +64,7 @@ main = defaultMain $ testGroup "HIE"

6464 , haddockTests

6565 , positionMappingTests

6666 , watchedFilesTests

67+ , sessionDepsArePickedUp

6768 ]

6869

6970initializeResponseTests :: TestTree

@@ -1774,6 +1775,44 @@ haddockTests

17741775 where

17751776 checkHaddock s txt = spanDocToMarkdownForTest s @?= txt

17761777

1778+

1779+sessionDepsArePickedUp :: TestTree

1780+sessionDepsArePickedUp = testSession'

1781+ "session-deps-are-picked-up"

1782+ $ \dir -> do

1783+ liftIO $

1784+ writeFileUTF8

1785+ (dir </> "hie.yaml")

1786+ "cradle: {direct: {arguments: []}}"

1787+ -- Open without OverloadedStrings and expect an error.

1788+ doc <- openDoc' "Foo.hs" "haskell" fooContent

1789+ expectDiagnostics

1790+ [("Foo.hs", [(DsError, (3, 6), "Couldn't match expected type")])]

1791+ -- Update hie.yaml to enable OverloadedStrings.

1792+ liftIO $

1793+ writeFileUTF8

1794+ (dir </> "hie.yaml")

1795+ "cradle: {direct: {arguments: [-XOverloadedStrings]}}"

1796+ -- Send change event.

1797+ let change =

1798+ TextDocumentContentChangeEvent

1799+ { _range = Just (Range (Position 4 0) (Position 4 0)),

1800+ _rangeLength = Nothing,

1801+ _text = "\n"

1802+ }

1803+ changeDoc doc [change]

1804+ -- Now no errors.

1805+ expectDiagnostics [("Foo.hs", [])]

1806+ where

1807+ fooContent =

1808+ T.unlines

1809+ [ "module Foo where",

1810+ "import Data.Text",

1811+ "foo :: Text",

1812+ "foo = \"hello\""

1813+ ]

1814+

1815+

17771816----------------------------------------------------------------------

17781817-- Utils

17791818

@@ -1781,6 +1820,9 @@ haddockTests

17811820testSession :: String -> Session () -> TestTree

17821821testSession name = testCase name . run

17831822

1823+testSession' :: String -> (FilePath -> Session ()) -> TestTree

1824+testSession' name = testCase name . run'

1825+

17841826testSessionWait :: String -> Session () -> TestTree

17851827testSessionWait name = testSession name .

17861828 -- Check that any diagnostics produced were already consumed by the test case.

@@ -1801,7 +1843,13 @@ mkRange :: Int -> Int -> Int -> Int -> Range

18011843mkRange a b c d = Range (Position a b) (Position c d)

18021844

18031845run :: Session a -> IO a

1804−run s = withTempDir $ \dir -> do

1846+run s = withTempDir $ \dir -> runInDir dir s

1847+

1848+run' :: (FilePath -> Session a) -> IO a

1849+run' s = withTempDir $ \dir -> runInDir dir (s dir)

1850+

1851+runInDir :: FilePath -> Session a -> IO a

1852+runInDir dir s = do

18051853 ghcideExe <- locateGhcideExecutable

18061854

18071855 -- Temporarily hack around https://github.com/mpickering/hie-bios/pull/56