From 5a896aa548c27c9271883e271863bbc7944bc0ac Mon Sep 17 00:00:00 2001 From: Alan Zimmerman Date: Thu, 23 Apr 2020 19:21:37 +0100 Subject: [PATCH 1/5] 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 bea31360cc..45af30bed5 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 dc494d863f..0fa72a2bf9 160000 --- a/ghcide +++ b/ghcide @@ -1 +1 @@ -Subproject commit dc494d863fcce34863832f2cdb10c923e20a76b6 +Subproject commit 0fa72a2bf9d7344208fc3127402207a5e94d5bea diff --git a/haskell-language-server.cabal b/haskell-language-server.cabal index 677f574404..75660a2a35 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 1f9ac76de0d884f4bd4d6694a49af12553d3bfbd Mon Sep 17 00:00:00 2001 From: Alan Zimmerman Date: Sun, 26 Apr 2020 23:22:35 +0100 Subject: [PATCH 2/5] Rebasing against mpickering/wip/use-stale-fast At commit f9b0afb5231e07560640fa60493384e762016f46 --- exe/Main.hs | 4 ++-- src/Ide/Plugin/Example.hs | 2 +- src/Ide/Plugin/Example2.hs | 2 +- 3 files changed, 4 insertions(+), 4 deletions(-) diff --git a/exe/Main.hs b/exe/Main.hs index 373d7357e8..a9f0aa8382 100644 --- a/exe/Main.hs +++ b/exe/Main.hs @@ -195,7 +195,7 @@ main = do , optInterfaceLoadingDiagnostics = argsTesting } debouncer <- newAsyncDebouncer - initialise caps (mainRule >> pluginRules plugins) + fst <$> 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 @@ -219,7 +219,7 @@ main = do putStrLn "\nStep 3/6: Initializing the IDE" vfs <- makeVFSHandle debouncer <- newAsyncDebouncer - ide <- initialise def mainRule (pure $ IdInt 0) (showEvent lock) (logger Info) debouncer (defaultIdeOptions $ loadSession dir) vfs + (ide, _worker) <- initialise def mainRule (pure $ IdInt 0) (showEvent lock) (logger Info) debouncer (defaultIdeOptions $ loadSession dir) vfs putStrLn "\nStep 4/6: Type checking the files" setFilesOfInterest ide $ HashSet.fromList $ map toNormalizedFilePath' files diff --git a/src/Ide/Plugin/Example.hs b/src/Ide/Plugin/Example.hs index 02e1a7c0b1..8a253b461b 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 "Example.codeLens" ideState $ runMaybeT $ useE TypeCheck filePath + _ <- runIdeAction "Example.codeLens" ideState $ runMaybeT $ useE TypeCheck filePath _diag <- getDiagnostics ideState _hDiag <- getHiddenDiagnostics ideState let diff --git a/src/Ide/Plugin/Example2.hs b/src/Ide/Plugin/Example2.hs index 696c3f196c..5ce6fa4584 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 (fromNormalizedFilePath filePath) ideState $ runMaybeT $ useE TypeCheck filePath + _ <- runIdeAction (fromNormalizedFilePath filePath) ideState $ runMaybeT $ useE TypeCheck filePath _diag <- getDiagnostics ideState _hDiag <- getHiddenDiagnostics ideState let From 0a7f6390b86d0f9040639190239088add635cb4d Mon Sep 17 00:00:00 2001 From: Alan Zimmerman Date: Mon, 27 Apr 2020 18:46:32 +0100 Subject: [PATCH 3/5] Adapt to mpickering latest, wip/propogate At 489370672e7117e6c79e47b2ab4b31d0e7fe412d --- exe/Main.hs | 44 ++++++++++++++++++++++++++++---------------- ghcide | 2 +- 2 files changed, 29 insertions(+), 17 deletions(-) diff --git a/exe/Main.hs b/exe/Main.hs index a9f0aa8382..947047a433 100644 --- a/exe/Main.hs +++ b/exe/Main.hs @@ -407,7 +407,7 @@ loadSession dir = liftIO $ do modifyVar_ fileToFlags $ \var -> do pure $ Map.insert hieYaml (HM.fromList (cs ++ cached_targets)) var - return res + return (cs, res) lock <- newLock @@ -431,7 +431,7 @@ loadSession dir = liftIO $ do case HM.lookup (toNormalizedFilePath' cfp) v of Just opts -> do --putStrLn $ "Cached component of " <> show file - pure (fst opts) + pure ([], fst opts) Nothing-> do finished_barrier <- newBarrier -- fork a new thread here which won't be killed by shake @@ -441,8 +441,8 @@ loadSession dir = liftIO $ do cradle <- maybe (loadImplicitCradle $ addTrailingPathSeparator dir) loadCradle hieYaml opts <- cradleToSessionOpts cradle cfp print opts - res <- fst <$> session (hieYaml, toNormalizedFilePath' cfp, opts) - signalBarrier finished_barrier res + (cs, res)<- session (hieYaml, toNormalizedFilePath' cfp, opts) + signalBarrier finished_barrier (cs, fst res) waitBarrier finished_barrier dummyAs <- async $ return (error "Uninitialised") @@ -453,18 +453,30 @@ loadSession dir = liftIO $ 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 + return $ \file -> do + (cs, opts) <- + 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 + let cfps = map fst cs + -- Delayed to avoid recursion and only run if something changed. + unless (null cs) ( + delay "InitialLoad" $ void $ do + cfps' <- liftIO $ filterM (IO.doesFileExist . fromNormalizedFilePath) cfps + mmt <- uses GetModificationTime cfps' + let cs_exist = catMaybes (zipWith (<$) cfps' mmt) + uses GetModIface cs_exist) + return opts + diff --git a/ghcide b/ghcide index b9ae3e4358..59469bda11 160000 --- a/ghcide +++ b/ghcide @@ -1 +1 @@ -Subproject commit b9ae3e4358bad630bf1ca8ec92b5753b3b4853fb +Subproject commit 59469bda1161ce35a3a2eb023c750465ef635370 From bc457df073c10181d30ac5c2b63d655a7ab4e3be Mon Sep 17 00:00:00 2001 From: Alan Zimmerman Date: Thu, 30 Apr 2020 22:42:17 +0100 Subject: [PATCH 4/5] Update to use ghcide based on mpickering/wip/stale-logic --- exe/Main.hs | 3 ++- ghcide | 2 +- src/Ide/Types.hs | 1 + 3 files changed, 4 insertions(+), 2 deletions(-) diff --git a/exe/Main.hs b/exe/Main.hs index 947047a433..d60b12d770 100644 --- a/exe/Main.hs +++ b/exe/Main.hs @@ -219,13 +219,14 @@ main = do putStrLn "\nStep 3/6: Initializing the IDE" vfs <- makeVFSHandle debouncer <- newAsyncDebouncer - (ide, _worker) <- initialise def mainRule (pure $ IdInt 0) (showEvent lock) (logger Info) debouncer (defaultIdeOptions $ loadSession dir) vfs + (ide, worker) <- initialise def mainRule (pure $ IdInt 0) (showEvent lock) (logger Info) debouncer (defaultIdeOptions $ loadSession dir) vfs putStrLn "\nStep 4/6: Type checking the files" setFilesOfInterest ide $ HashSet.fromList $ 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" + cancel worker return () expandFiles :: [FilePath] -> IO [FilePath] diff --git a/ghcide b/ghcide index 59469bda11..a9db2ad597 160000 --- a/ghcide +++ b/ghcide @@ -1 +1 @@ -Subproject commit 59469bda1161ce35a3a2eb023c750465ef635370 +Subproject commit a9db2ad597c8938e2413dd5a456ec51e7c656298 diff --git a/src/Ide/Types.hs b/src/Ide/Types.hs index 71b9eb6264..bb17fd4beb 100644 --- a/src/Ide/Types.hs +++ b/src/Ide/Types.hs @@ -83,6 +83,7 @@ data PluginCommand = forall a. (FromJSON a) => , commandDesc :: T.Text , commandFunc :: CommandFunction a } + -- --------------------------------------------------------------------- type CommandFunction a = LSP.LspFuncs Config From 992ffb1267f2790b3a664fdf2ebcc77f871c2222 Mon Sep 17 00:00:00 2001 From: Alan Zimmerman Date: Sat, 2 May 2020 13:49:15 +0100 Subject: [PATCH 5/5] Use mpickering/hls ghcide branch At b4c3619346f4fe89ac036322fdd9ed178fb66685 --- exe/Main.hs | 6 +++--- ghcide | 2 +- stack-8.6.4.yaml | 1 + stack-8.6.5.yaml | 1 + stack.yaml | 1 + 5 files changed, 7 insertions(+), 4 deletions(-) diff --git a/exe/Main.hs b/exe/Main.hs index d60b12d770..8ed5b112d5 100644 --- a/exe/Main.hs +++ b/exe/Main.hs @@ -223,7 +223,7 @@ main = do putStrLn "\nStep 4/6: Type checking the files" setFilesOfInterest ide $ HashSet.fromList $ map toNormalizedFilePath' files - _ <- runActionSync "TypecheckTest" 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" cancel worker @@ -471,11 +471,11 @@ loadSession dir = liftIO $ do let cfps = map fst cs -- Delayed to avoid recursion and only run if something changed. unless (null cs) ( - delay "InitialLoad" $ void $ do + delay "InitialLoad" ("InitialLoad" :: String, cfps) (void $ do cfps' <- liftIO $ filterM (IO.doesFileExist . fromNormalizedFilePath) cfps mmt <- uses GetModificationTime cfps' let cs_exist = catMaybes (zipWith (<$) cfps' mmt) - uses GetModIface cs_exist) + uses GetModIface cs_exist)) return opts diff --git a/ghcide b/ghcide index a9db2ad597..648a2a7dff 160000 --- a/ghcide +++ b/ghcide @@ -1 +1 @@ -Subproject commit a9db2ad597c8938e2413dd5a456ec51e7c656298 +Subproject commit 648a2a7dff78f59836b62f3eae9f8342a6a8ec71 diff --git a/stack-8.6.4.yaml b/stack-8.6.4.yaml index dcb26bb424..79daaac6e7 100644 --- a/stack-8.6.4.yaml +++ b/stack-8.6.4.yaml @@ -37,6 +37,7 @@ extra-deps: - monad-memo-0.4.1 - multistate-0.8.0.1 - ormolu-0.0.5.0 +- opentelemetry-0.3.0 - parser-combinators-1.2.1 - regex-base-0.94.0.0 - regex-tdfa-1.3.1.0 diff --git a/stack-8.6.5.yaml b/stack-8.6.5.yaml index f45686f58a..b2ac65da02 100644 --- a/stack-8.6.5.yaml +++ b/stack-8.6.5.yaml @@ -28,6 +28,7 @@ extra-deps: - indexed-profunctors-0.1 - lsp-test-0.10.2.0 - monad-dijkstra-0.1.1.2 +- opentelemetry-0.3.0 - optics-core-0.2 - optparse-applicative-0.15.1.0 - ormolu-0.0.5.0 diff --git a/stack.yaml b/stack.yaml index 3df729b0cf..29f9675f35 100644 --- a/stack.yaml +++ b/stack.yaml @@ -27,6 +27,7 @@ extra-deps: - indexed-profunctors-0.1 - lsp-test-0.10.2.0 - monad-dijkstra-0.1.1.2 +- opentelemetry-0.3.0 - optics-core-0.2 - optparse-applicative-0.15.1.0 - ormolu-0.0.5.0