From 16b3a66e76a58ee56bace0c7d541e754f0c56f48 Mon Sep 17 00:00:00 2001 From: Alan Zimmerman Date: Thu, 23 Apr 2020 19:21:37 +0100 Subject: [PATCH 1/4] Rebase on mpickering ghcide at wip/multi-rebase Commit 256f8b50415a08454d471a6a28f742c0a1e39978 --- exe/Arguments.hs | 2 +- exe/Main.hs | 36 ++++++++++++++++++++++++++++------- ghcide | 2 +- haskell-language-server.cabal | 1 + 4 files changed, 32 insertions(+), 9 deletions(-) diff --git a/exe/Arguments.hs b/exe/Arguments.hs index f07d8254e5..7abecdff18 100644 --- a/exe/Arguments.hs +++ b/exe/Arguments.hs @@ -36,7 +36,7 @@ data Arguments = Arguments -- them to just change the name of the exe and still work. , argsDebugOn :: Bool , argsLogFile :: Maybe String - , argsThread :: Int + , argsThreads :: Int } deriving Show getArguments :: String -> IO Arguments diff --git a/exe/Main.hs b/exe/Main.hs index 6e2586283d..35cf5c0c35 100644 --- a/exe/Main.hs +++ b/exe/Main.hs @@ -13,6 +13,7 @@ module Main(main) where import Arguments +import Control.Concurrent.Async import Control.Concurrent.Extra import Control.Exception import Control.Monad.Extra @@ -190,8 +191,8 @@ main = do { optReportProgress = clientSupportsProgress caps , optShakeProfiling = argsShakeProfiling , optTesting = argsTesting + , optThreads = argsThreads , optInterfaceLoadingDiagnostics = argsTesting - , optThreads = argsThread } debouncer <- newAsyncDebouncer initialise caps (mainRule >> pluginRules plugins >> action kick) @@ -408,7 +409,6 @@ loadSession dir = liftIO $ do return res lock <- newLock - cradle_lock <- newLock -- This caches the mapping from hie.yaml + Mod.hs -> [String] sessionOpts <- return $ \(hieYaml, file) -> do @@ -435,17 +435,39 @@ loadSession dir = liftIO $ do 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 + void $ forkIO $ do + putStrLn $ "Consulting the cradle for " <> 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) + + dummyAs <- async $ return (error "Uninitialised") + runningCradle <- newIORef dummyAs + -- The main function which gets options for a file. We only want one of these running + -- at a time. + let getOptions file = do + hieYaml <- cradleLoc file + sessionOpts (hieYaml, file) + -- The lock is on the `runningCradle` resource + return $ \file -> liftIO $ withLock lock $ do + as <- readIORef runningCradle + finished <- poll as + case finished of + Just {} -> do + as <- async $ getOptions file + writeIORef runningCradle as + wait as + -- If it's not finished then wait and then get options, this could of course be killed still + Nothing -> do + _ <- wait as + getOptions file + + + + checkDependencyInfo :: Map.Map FilePath (Maybe UTCTime) -> IO Bool checkDependencyInfo old_di = do diff --git a/ghcide b/ghcide index af15fd103f..b0cd53d651 160000 --- a/ghcide +++ b/ghcide @@ -1 +1 @@ -Subproject commit af15fd103f84d5a8701de298a9db0981c14cbf74 +Subproject commit b0cd53d651855a8b1eb3b88c5b1d340ab31f7f30 diff --git a/haskell-language-server.cabal b/haskell-language-server.cabal index fba933af56..3f6e66e5e8 100644 --- a/haskell-language-server.cabal +++ b/haskell-language-server.cabal @@ -133,6 +133,7 @@ executable haskell-language-server build-depends: base >=4.7 && <5 , aeson + , async , base16-bytestring , binary , bytestring From 3a0a85ef31892ddd3c57b21055a326ffcdfaac77 Mon Sep 17 00:00:00 2001 From: Alan Zimmerman Date: Sat, 25 Apr 2020 19:16:16 +0100 Subject: [PATCH 2/4] Fix up for rebase on mpickering branch --- cabal.project | 4 ++++ exe/Main.hs | 4 ++-- src/Ide/Plugin/Example.hs | 4 ++-- src/Ide/Plugin/Example2.hs | 4 ++-- src/Ide/Plugin/Formatter.hs | 2 +- src/Ide/Plugin/Ormolu.hs | 2 +- 6 files changed, 12 insertions(+), 8 deletions(-) diff --git a/cabal.project b/cabal.project index a0f6ff14c0..88ae340457 100644 --- a/cabal.project +++ b/cabal.project @@ -12,6 +12,10 @@ source-repository-package location: https://github.com/fendor/hie-bios.git tag: 89d28817716a1c8df7e191f3a43c4504bc6379eb +source-repository-package + type: git + location: https://github.com/mpickering/shake + tag: 4d56fe9f09bd3bd63ead541c571c756995da490a tests: true documentation: false diff --git a/exe/Main.hs b/exe/Main.hs index 35cf5c0c35..b0c2640697 100644 --- a/exe/Main.hs +++ b/exe/Main.hs @@ -224,7 +224,7 @@ main = do putStrLn "\nStep 4/6: Type checking the files" setFilesOfInterest ide $ HashSet.fromList $ map toNormalizedFilePath' files - _ <- runActionSync ide $ uses TypeCheck (map toNormalizedFilePath' files) + _ <- runActionSync "TypecheckTest" ide $ uses TypeCheck (map toNormalizedFilePath' files) -- results <- runActionSync ide $ use TypeCheck $ toNormalizedFilePath' "src/Development/IDE/Core/Rules.hs" -- results <- runActionSync ide $ use TypeCheck $ toNormalizedFilePath' "exe/Main.hs" return () @@ -523,7 +523,7 @@ memoIO op = do Just res -> return (mp, res) setOptions :: GhcMonad m => ComponentOptions -> DynFlags -> m (DynFlags, [Target]) -setOptions (ComponentOptions theOpts compRoot _) dflags = do +setOptions (ComponentOptions theOpts _compRoot _) dflags = do cacheDir <- liftIO $ getCacheDir theOpts (dflags_, targets) <- addCmdOpts theOpts dflags let dflags' = makeDynFlagsAbsolute compRoot dflags_ diff --git a/src/Ide/Plugin/Example.hs b/src/Ide/Plugin/Example.hs index ddf5747989..54f8028947 100644 --- a/src/Ide/Plugin/Example.hs +++ b/src/Ide/Plugin/Example.hs @@ -125,7 +125,7 @@ codeLens _lf ideState plId CodeLensParams{_textDocument=TextDocumentIdentifier u logInfo (ideLogger ideState) "Example.codeLens entered (ideLogger)" -- AZ case uriToFilePath' uri of Just (toNormalizedFilePath -> filePath) -> do - _ <- runAction ideState $ runMaybeT $ useE TypeCheck filePath + _ <- runAction (fromNormalizedFilePath filePath) ideState $ runMaybeT $ useE TypeCheck filePath _diag <- getDiagnostics ideState _hDiag <- getHiddenDiagnostics ideState let @@ -190,7 +190,7 @@ logAndRunRequest label getResults ide pos path = do logInfo (ideLogger ide) $ label <> " request at position " <> T.pack (showPosition pos) <> " in file: " <> T.pack path - runAction ide $ getResults filePath pos + runAction path ide $ getResults filePath pos -- --------------------------------------------------------------------- diff --git a/src/Ide/Plugin/Example2.hs b/src/Ide/Plugin/Example2.hs index a6f56cbfc0..be5bd3683b 100644 --- a/src/Ide/Plugin/Example2.hs +++ b/src/Ide/Plugin/Example2.hs @@ -125,7 +125,7 @@ codeLens _lf ideState plId CodeLensParams{_textDocument=TextDocumentIdentifier u logInfo (ideLogger ideState) "Example2.codeLens entered (ideLogger)" -- AZ case uriToFilePath' uri of Just (toNormalizedFilePath -> filePath) -> do - _ <- runAction ideState $ runMaybeT $ useE TypeCheck filePath + _ <- runAction (fromNormalizedFilePath filePath) ideState $ runMaybeT $ useE TypeCheck filePath _diag <- getDiagnostics ideState _hDiag <- getHiddenDiagnostics ideState let @@ -187,7 +187,7 @@ logAndRunRequest label getResults ide pos path = do logInfo (ideLogger ide) $ label <> " request at position " <> T.pack (showPosition pos) <> " in file: " <> T.pack path - runAction ide $ getResults filePath pos + runAction path ide $ getResults filePath pos -- --------------------------------------------------------------------- diff --git a/src/Ide/Plugin/Formatter.hs b/src/Ide/Plugin/Formatter.hs index 302ea5d784..6069e3304a 100644 --- a/src/Ide/Plugin/Formatter.hs +++ b/src/Ide/Plugin/Formatter.hs @@ -64,7 +64,7 @@ doFormatting lf providers ideState ft uri params = do Just provider -> case uriToFilePath uri of Just (toNormalizedFilePath -> fp) -> do - (_, mb_contents) <- runAction ideState $ getFileContents fp + (_, mb_contents) <- runAction (fromNormalizedFilePath fp) ideState $ getFileContents fp case mb_contents of Just contents -> do logDebug (ideLogger ideState) $ T.pack $ diff --git a/src/Ide/Plugin/Ormolu.hs b/src/Ide/Plugin/Ormolu.hs index 4ae80d4336..710a0a2662 100644 --- a/src/Ide/Plugin/Ormolu.hs +++ b/src/Ide/Plugin/Ormolu.hs @@ -59,7 +59,7 @@ provider _lf ideState typ contents fp _ = do in return $ map DynOption $ pp <> pm <> ex - m_parsed <- runAction ideState $ getParsedModule fp + m_parsed <- runAction (fromNormalizedFilePath fp) ideState $ getParsedModule fp fileOpts <- case m_parsed of Nothing -> return [] Just pm -> fromDyn pm From 856be569aeb2262d25746ebb56c654e6d4c27583 Mon Sep 17 00:00:00 2001 From: Alan Zimmerman Date: Sat, 25 Apr 2020 20:48:42 +0100 Subject: [PATCH 3/4] Fix according to review comments --- exe/Main.hs | 2 +- src/Ide/Plugin/Example.hs | 4 ++-- src/Ide/Plugin/Example2.hs | 2 +- src/Ide/Plugin/Formatter.hs | 2 +- src/Ide/Plugin/Ormolu.hs | 2 +- 5 files changed, 6 insertions(+), 6 deletions(-) diff --git a/exe/Main.hs b/exe/Main.hs index b0c2640697..07d1aa030e 100644 --- a/exe/Main.hs +++ b/exe/Main.hs @@ -523,7 +523,7 @@ memoIO op = do Just res -> return (mp, res) setOptions :: GhcMonad m => ComponentOptions -> DynFlags -> m (DynFlags, [Target]) -setOptions (ComponentOptions theOpts _compRoot _) dflags = do +setOptions (ComponentOptions theOpts compRoot _) dflags = do cacheDir <- liftIO $ getCacheDir theOpts (dflags_, targets) <- addCmdOpts theOpts dflags let dflags' = makeDynFlagsAbsolute compRoot dflags_ diff --git a/src/Ide/Plugin/Example.hs b/src/Ide/Plugin/Example.hs index 54f8028947..02e1a7c0b1 100644 --- a/src/Ide/Plugin/Example.hs +++ b/src/Ide/Plugin/Example.hs @@ -125,7 +125,7 @@ codeLens _lf ideState plId CodeLensParams{_textDocument=TextDocumentIdentifier u logInfo (ideLogger ideState) "Example.codeLens entered (ideLogger)" -- AZ case uriToFilePath' uri of Just (toNormalizedFilePath -> filePath) -> do - _ <- runAction (fromNormalizedFilePath filePath) ideState $ runMaybeT $ useE TypeCheck filePath + _ <- runAction "Example.codeLens" ideState $ runMaybeT $ useE TypeCheck filePath _diag <- getDiagnostics ideState _hDiag <- getHiddenDiagnostics ideState let @@ -190,7 +190,7 @@ logAndRunRequest label getResults ide pos path = do logInfo (ideLogger ide) $ label <> " request at position " <> T.pack (showPosition pos) <> " in file: " <> T.pack path - runAction path ide $ getResults filePath pos + runAction "Example" ide $ getResults filePath pos -- --------------------------------------------------------------------- diff --git a/src/Ide/Plugin/Example2.hs b/src/Ide/Plugin/Example2.hs index be5bd3683b..696c3f196c 100644 --- a/src/Ide/Plugin/Example2.hs +++ b/src/Ide/Plugin/Example2.hs @@ -187,7 +187,7 @@ logAndRunRequest label getResults ide pos path = do logInfo (ideLogger ide) $ label <> " request at position " <> T.pack (showPosition pos) <> " in file: " <> T.pack path - runAction path ide $ getResults filePath pos + runAction "Example2" ide $ getResults filePath pos -- --------------------------------------------------------------------- diff --git a/src/Ide/Plugin/Formatter.hs b/src/Ide/Plugin/Formatter.hs index 6069e3304a..5fccb50b4a 100644 --- a/src/Ide/Plugin/Formatter.hs +++ b/src/Ide/Plugin/Formatter.hs @@ -64,7 +64,7 @@ doFormatting lf providers ideState ft uri params = do Just provider -> case uriToFilePath uri of Just (toNormalizedFilePath -> fp) -> do - (_, mb_contents) <- runAction (fromNormalizedFilePath fp) ideState $ getFileContents fp + (_, mb_contents) <- runAction "Formatter" ideState $ getFileContents fp case mb_contents of Just contents -> do logDebug (ideLogger ideState) $ T.pack $ diff --git a/src/Ide/Plugin/Ormolu.hs b/src/Ide/Plugin/Ormolu.hs index 710a0a2662..0197c8e2b3 100644 --- a/src/Ide/Plugin/Ormolu.hs +++ b/src/Ide/Plugin/Ormolu.hs @@ -59,7 +59,7 @@ provider _lf ideState typ contents fp _ = do in return $ map DynOption $ pp <> pm <> ex - m_parsed <- runAction (fromNormalizedFilePath fp) ideState $ getParsedModule fp + m_parsed <- runAction "Ormolu" ideState $ getParsedModule fp fileOpts <- case m_parsed of Nothing -> return [] Just pm -> fromDyn pm From 61f364c4c288b1a9b42fdcfadf146cdb1f8bb419 Mon Sep 17 00:00:00 2001 From: Alan Zimmerman Date: Sun, 26 Apr 2020 11:56:01 +0100 Subject: [PATCH 4/4] Update to latest mpickering ghcide version at 3dde18f06ea18731bb3befa0d81af9a6b894d917 --- exe/Main.hs | 8 +++++--- stack-8.6.4.yaml | 8 +++++--- stack-8.6.5.yaml | 5 ++++- stack-8.8.2.yaml | 4 +++- stack-8.8.3.yaml | 4 +++- 5 files changed, 20 insertions(+), 9 deletions(-) diff --git a/exe/Main.hs b/exe/Main.hs index 07d1aa030e..73fb779fdf 100644 --- a/exe/Main.hs +++ b/exe/Main.hs @@ -49,7 +49,7 @@ import Development.IDE.Types.Diagnostics import Development.IDE.Types.Location import Development.IDE.Types.Logger import Development.IDE.Types.Options -import Development.Shake (Action, action) +import Development.Shake (Action) import DynFlags (gopt_set, gopt_unset, updOptLevel) import DynFlags (PackageFlag(..), PackageArg(..)) @@ -195,7 +195,7 @@ main = do , optInterfaceLoadingDiagnostics = argsTesting } debouncer <- newAsyncDebouncer - initialise caps (mainRule >> pluginRules plugins >> action kick) + initialise caps (mainRule >> pluginRules plugins) getLspId event hlsLogger debouncer options vfs else do -- GHC produces messages with UTF8 in them, so make sure the terminal doesn't error @@ -241,11 +241,13 @@ expandFiles = concatMapM $ \x -> do fail $ "Couldn't find any .hs/.lhs files inside directory: " ++ x return files - +-- Running this every hover is too expensive, 0.2s on GHC for example +{- kick :: Action () kick = do files <- getFilesOfInterest void $ uses TypeCheck $ HashSet.toList files + -} -- | Print an LSP event. showEvent :: Lock -> FromServerMessage -> IO () diff --git a/stack-8.6.4.yaml b/stack-8.6.4.yaml index d0c7b507e6..dcb26bb424 100644 --- a/stack-8.6.4.yaml +++ b/stack-8.6.4.yaml @@ -14,7 +14,7 @@ extra-deps: - cabal-plan-0.5.0.0 - constrained-dynamic-0.1.0.0 # - ghcide-0.1.0 -- extra-1.6.18 +- extra-1.6.21 - floskell-0.10.2 - fuzzy-0.1.0.0 - ghc-check-0.1.0.3 @@ -28,7 +28,7 @@ extra-deps: - haskell-src-exts-1.21.1 # - hie-bios-0.4.0 - github: fendor/hie-bios - commit: 89d28817716a1c8df7e191f3a43c4504bc6379eb + commit: 87db34de1b10b03bb2c3d7f6bd3623bc1da96ba8 - hlint-2.2.8 - hoogle-5.0.17.11 - hsimport-0.11.0 @@ -41,7 +41,9 @@ extra-deps: - regex-base-0.94.0.0 - regex-tdfa-1.3.1.0 - rope-utf16-splay-0.3.1.0 -- shake-0.18.5 +# - shake-0.18.5 +- github: mpickering/shake + commit: 4d56fe9f09bd3bd63ead541c571c756995da490a - syz-0.2.0.0 - tasty-rerun-1.1.17 - temporary-1.2.1.1 diff --git a/stack-8.6.5.yaml b/stack-8.6.5.yaml index 1b76d49e34..f45686f58a 100644 --- a/stack-8.6.5.yaml +++ b/stack-8.6.5.yaml @@ -14,6 +14,7 @@ extra-deps: - clock-0.7.2 - floskell-0.10.2 # - ghcide-0.1.0 +- extra-1.6.21 - fuzzy-0.1.0.0 - ghc-check-0.1.0.3 - ghc-lib-parser-8.10.1.20200412 @@ -23,7 +24,7 @@ extra-deps: - haskell-lsp-types-0.21.0.0 # - hie-bios-0.4.0 - github: fendor/hie-bios - commit: 89d28817716a1c8df7e191f3a43c4504bc6379eb + commit: 87db34de1b10b03bb2c3d7f6bd3623bc1da96ba8 - indexed-profunctors-0.1 - lsp-test-0.10.2.0 - monad-dijkstra-0.1.1.2 @@ -34,6 +35,8 @@ extra-deps: - regex-base-0.94.0.0 - regex-pcre-builtin-0.95.1.1.8.43 - regex-tdfa-1.3.1.0 +- github: mpickering/shake + commit: 4d56fe9f09bd3bd63ead541c571c756995da490a - semialign-1.1 - tasty-rerun-1.1.17 - temporary-1.2.1.1 diff --git a/stack-8.8.2.yaml b/stack-8.8.2.yaml index 299d819be3..e76281e23c 100644 --- a/stack-8.8.2.yaml +++ b/stack-8.8.2.yaml @@ -23,7 +23,7 @@ extra-deps: - haskell-src-exts-1.21.1 # - hie-bios-0.4.0 - github: fendor/hie-bios - commit: 89d28817716a1c8df7e191f3a43c4504bc6379eb + commit: 87db34de1b10b03bb2c3d7f6bd3623bc1da96ba8 - hlint-2.2.8 - hoogle-5.0.17.11 - hsimport-0.11.0 @@ -32,6 +32,8 @@ extra-deps: - monad-dijkstra-0.1.1.2 - ormolu-0.0.5.0 - semigroups-0.18.5 +- github: mpickering/shake + commit: 4d56fe9f09bd3bd63ead541c571c756995da490a - temporary-1.2.1.1 flags: diff --git a/stack-8.8.3.yaml b/stack-8.8.3.yaml index c936ed683a..f214b9fc1e 100644 --- a/stack-8.8.3.yaml +++ b/stack-8.8.3.yaml @@ -23,7 +23,7 @@ extra-deps: - haskell-src-exts-1.21.1 # - hie-bios-0.4.0 - github: fendor/hie-bios - commit: 89d28817716a1c8df7e191f3a43c4504bc6379eb + commit: 87db34de1b10b03bb2c3d7f6bd3623bc1da96ba8 - hlint-2.2.8 - hoogle-5.0.17.11 - hsimport-0.11.0 @@ -32,6 +32,8 @@ extra-deps: - monad-dijkstra-0.1.1.2 - ormolu-0.0.5.0 - semigroups-0.18.5 +- github: mpickering/shake + commit: 4d56fe9f09bd3bd63ead541c571c756995da490a - temporary-1.2.1.1 flags: