From 83da0337ff97941bf79cf81edf2c1f90598a1366 Mon Sep 17 00:00:00 2001 From: Luke Lau Date: Fri, 25 Oct 2019 22:24:06 +0100 Subject: [PATCH 01/67] Respect snippets configutation in CompletionItemResolve Fixes #1422 --- src/Haskell/Ide/Engine/LSP/Completions.hs | 50 +++++++++++--------- src/Haskell/Ide/Engine/Transport/LspStdio.hs | 3 +- test/functional/CompletionSpec.hs | 10 +++- 3 files changed, 39 insertions(+), 24 deletions(-) diff --git a/src/Haskell/Ide/Engine/LSP/Completions.hs b/src/Haskell/Ide/Engine/LSP/Completions.hs index 1fba462d7..89f154f20 100644 --- a/src/Haskell/Ide/Engine/LSP/Completions.hs +++ b/src/Haskell/Ide/Engine/LSP/Completions.hs @@ -43,6 +43,8 @@ import Var import Language.Haskell.Refact.API ( showGhc ) import qualified Language.Haskell.LSP.Types as J +import qualified Language.Haskell.LSP.Types.Capabilities + as J import qualified Language.Haskell.LSP.Types.Lens as J import qualified Haskell.Ide.Engine.Support.Fuzzy @@ -93,8 +95,8 @@ instance FromJSON CompItemResolveData where instance ToJSON CompItemResolveData where toJSON = genericToJSON $ customOptions 0 -resolveCompletion :: J.CompletionItem -> IdeM J.CompletionItem -resolveCompletion origCompl = +resolveCompletion :: WithSnippets -> J.CompletionItem -> IdeM J.CompletionItem +resolveCompletion withSnippets origCompl = case fromJSON <$> origCompl ^. J.xdata of Just (J.Success compdata) -> do mdocs <- Hoogle.infoCmd' $ hoogleQuery compdata @@ -114,10 +116,11 @@ resolveCompletion origCompl = insertText = label <> " " <> getArgText typ det = Just . stripForall $ T.pack (showGhc typ) <> "\n" pure (det,Just insertText) - return $ origCompl & J.documentation .~ docs + let compl = origCompl & J.documentation .~ docs & J.insertText .~ insert & J.insertTextFormat ?~ J.Snippet & J.detail .~ (detail <> origCompl ^. J.detail) + toggleSnippets <$> getClientCapabilities <*> pure withSnippets <*> pure compl Just (J.Error err) -> do debugm $ "resolveCompletion: Decoding data failed because of: " ++ err pure origCompl @@ -294,26 +297,28 @@ instance ModuleCache CachedCompletions where newtype WithSnippets = WithSnippets Bool +toggleSnippets :: J.ClientCapabilities -> WithSnippets -> J.CompletionItem -> J.CompletionItem +toggleSnippets clientCaps (WithSnippets with) x + | with && supported = x + | otherwise = x { J._insertTextFormat = Just J.PlainText + , J._insertText = Nothing + } + where supported = fromMaybe False (clientCaps ^? J.textDocument + . _Just + . J.completion + . _Just + . J.completionItem + . _Just + . J.snippetSupport + . _Just) + -- | Returns the cached completions for the given module and position. getCompletions :: Uri -> VFS.PosPrefixInfo -> WithSnippets -> IdeM (IdeResult [J.CompletionItem]) -getCompletions uri prefixInfo (WithSnippets withSnippets) = +getCompletions uri prefixInfo withSnippets = pluginGetFile "getCompletions: " uri $ \file -> do - let snippetLens = (^? J.textDocument - . _Just - . J.completion - . _Just - . J.completionItem - . _Just - . J.snippetSupport - . _Just) - supportsSnippets <- fromMaybe False . snippetLens <$> getClientCapabilities - let toggleSnippets x - | withSnippets && supportsSnippets = x - | otherwise = x { J._insertTextFormat = Just J.PlainText - , J._insertText = Nothing - } - - VFS.PosPrefixInfo { VFS.fullLine, VFS.prefixModule, VFS.prefixText } = prefixInfo + caps <- getClientCapabilities + + let VFS.PosPrefixInfo { VFS.fullLine, VFS.prefixModule, VFS.prefixText } = prefixInfo debugm $ "got prefix" ++ show (prefixModule, prefixText) let enteredQual = if T.null prefixModule then "" else prefixModule <> "." fullPrefix = enteredQual <> prefixText @@ -379,7 +384,7 @@ getCompletions uri prefixInfo (WithSnippets withSnippets) = ] filtListWithSnippet f list suffix = - [ toggleSnippets (f label (snippet <> suffix)) + [ toggleSnippets caps withSnippets (f label (snippet <> suffix)) | (snippet, label) <- list , Fuzzy.test fullPrefix label ] @@ -404,7 +409,8 @@ getCompletions uri prefixInfo (WithSnippets withSnippets) = | "{-# " `T.isPrefixOf` fullLine = filtPragmaCompls (pragmaSuffix fullLine) | otherwise - = filtModNameCompls ++ map (toggleSnippets . mkCompl . stripAutoGenerated) filtCompls + = filtModNameCompls ++ map (toggleSnippets caps withSnippets + . mkCompl . stripAutoGenerated) filtCompls in return $ IdeResultOk result where diff --git a/src/Haskell/Ide/Engine/Transport/LspStdio.hs b/src/Haskell/Ide/Engine/Transport/LspStdio.hs index 5b57a8470..0e1f33702 100644 --- a/src/Haskell/Ide/Engine/Transport/LspStdio.hs +++ b/src/Haskell/Ide/Engine/Transport/LspStdio.hs @@ -648,12 +648,13 @@ reactor inp diagIn = do ReqCompletionItemResolve req -> do liftIO $ U.logs $ "reactor:got CompletionItemResolveRequest:" ++ show req + snippets <- Completions.WithSnippets <$> configVal completionSnippetsOn let origCompl = req ^. J.params callback res = do let rspMsg = Core.makeResponseMessage req $ res reactorSend $ RspCompletionItemResolve rspMsg hreq = IReq tn (req ^. J.id) callback $ runIdeResultT $ do - lift $ lift $ Completions.resolveCompletion origCompl + lift $ lift $ Completions.resolveCompletion snippets origCompl makeRequest hreq -- ------------------------------- diff --git a/test/functional/CompletionSpec.hs b/test/functional/CompletionSpec.hs index cce4d22d2..274fbc4bc 100644 --- a/test/functional/CompletionSpec.hs +++ b/test/functional/CompletionSpec.hs @@ -120,7 +120,7 @@ spec = describe "completions" $ do item ^. label `shouldBe` "OPTIONS_GHC" item ^. kind `shouldBe` Just CiKeyword item ^. insertTextFormat `shouldBe` Just Snippet - item ^. insertText `shouldBe` Just ("OPTIONS_GHC -${1:option} #-}") + item ^. insertText `shouldBe` Just "OPTIONS_GHC -${1:option} #-}" -- ----------------------------------- @@ -358,4 +358,12 @@ spec = describe "completions" $ do item ^. kind `shouldBe` Just CiFunction item ^. insertTextFormat `shouldBe` Just PlainText item ^. insertText `shouldBe` Nothing + + resolvedRes <- request CompletionItemResolve item + let Just (resolved :: CompletionItem) = resolvedRes ^. result + liftIO $ do + resolved ^. label `shouldBe` "foldl" + resolved ^. kind `shouldBe` Just CiFunction + resolved ^. insertTextFormat `shouldBe` Just PlainText + resolved ^. insertText `shouldBe` Nothing noSnippetsCaps = (textDocument . _Just . completion . _Just . completionItem . _Just . snippetSupport ?~ False) fullCaps From 10bba5a4b7fc2b95236c16b967d400ee5ab05323 Mon Sep 17 00:00:00 2001 From: Luke Lau Date: Sun, 27 Oct 2019 17:58:40 +0000 Subject: [PATCH 02/67] Register rename and implementation provider These need to be passed to haskell-lsp in order to declare it in the server capabilities. --- src/Haskell/Ide/Engine/Transport/LspStdio.hs | 2 ++ 1 file changed, 2 insertions(+) diff --git a/src/Haskell/Ide/Engine/Transport/LspStdio.hs b/src/Haskell/Ide/Engine/Transport/LspStdio.hs index 5b57a8470..3d5b7e48e 100644 --- a/src/Haskell/Ide/Engine/Transport/LspStdio.hs +++ b/src/Haskell/Ide/Engine/Transport/LspStdio.hs @@ -973,6 +973,8 @@ hieOptions commandIds = -- Hopefully the end May 2018 vscode release will stabilise -- this, it is a major rework of the machinery anyway. , Core.executeCommandProvider = Just (J.ExecuteCommandOptions (J.List commandIds)) + , Core.renameProvider = Just (J.RenameOptions (Just True)) + , Core.implementationProvider = Just (J.GotoOptionsStatic True) } From 257eda54bbd7d639247670078b8fdbd27b3c404a Mon Sep 17 00:00:00 2001 From: fendor Date: Tue, 29 Oct 2019 18:59:43 +0100 Subject: [PATCH 03/67] Drop stack support for GHC 8.2.2 This is necessary, because when we upgrade cabal-helper, and transivitely cabal-plan to version 0.5.0.0 in #1126, the minimum cabal-version is 2.2. However, each stack snapshot ships with its own version of cabal-install that can not be changed. The latest lts for ghc-8.2.2 is 11.18, which ships with a cabal-install version of 2.0.0.1, which is too old for cabal-plan 0.5.0.0. However, in general, there is nothing that forces us to drop support for GHC 8.2.2. Overriding the compiler version should be possible, e.g. taking the snapshort 14.8 and overriding the GHC version, but this requires us to do manual constraint solving. Could be done if needed. --- .azure/linux-stack.yml | 2 -- .azure/macos-stack.yml | 2 -- .azure/windows-stack.yml | 2 -- .circleci/config.yml | 16 -------------- appveyor.yml | 1 - stack-8.2.2.yaml | 48 ---------------------------------------- 6 files changed, 71 deletions(-) delete mode 100644 stack-8.2.2.yaml diff --git a/.azure/linux-stack.yml b/.azure/linux-stack.yml index ee5705ae2..ca39189e8 100644 --- a/.azure/linux-stack.yml +++ b/.azure/linux-stack.yml @@ -23,8 +23,6 @@ jobs: YAML_FILE: stack-8.4.3.yaml stack-8.4.2: YAML_FILE: stack-8.4.2.yaml - stack-8.2.2: - YAML_FILE: stack-8.2.2.yaml variables: STACK_ROOT: /home/vsts/.stack steps: diff --git a/.azure/macos-stack.yml b/.azure/macos-stack.yml index c139e5baa..42b45bb91 100644 --- a/.azure/macos-stack.yml +++ b/.azure/macos-stack.yml @@ -19,8 +19,6 @@ jobs: YAML_FILE: stack-8.4.3.yaml stack-8.4.2: YAML_FILE: stack-8.4.2.yaml - stack-8.2.2: - YAML_FILE: stack-8.2.2.yaml variables: STACK_ROOT: /Users/vsts/.stack steps: diff --git a/.azure/windows-stack.yml b/.azure/windows-stack.yml index 5bdacce5f..5707b5815 100644 --- a/.azure/windows-stack.yml +++ b/.azure/windows-stack.yml @@ -21,8 +21,6 @@ jobs: YAML_FILE: stack-8.4.3.yaml stack-8.4.2: YAML_FILE: stack-8.4.2.yaml - stack-8.2.2: - YAML_FILE: stack-8.2.2.yaml variables: STACK_ROOT: "C:\\sr" diff --git a/.circleci/config.yml b/.circleci/config.yml index 0858f26e8..af1247237 100644 --- a/.circleci/config.yml +++ b/.circleci/config.yml @@ -101,21 +101,6 @@ defaults: &defaults version: 2 jobs: - ghc-8.0.2: - environment: - - STACK_FILE: "stack-8.0.2.yaml" - <<: *defaults - - ghc-8.2.1: - environment: - - STACK_FILE: "stack-8.2.1.yaml" - <<: *defaults - - ghc-8.2.2: - environment: - - STACK_FILE: "stack-8.2.2.yaml" - <<: *defaults - ghc-8.4.2: environment: - STACK_FILE: "stack-8.4.2.yaml" @@ -199,7 +184,6 @@ workflows: version: 2 multiple-ghcs: jobs: - - ghc-8.2.2 - ghc-8.4.2 - ghc-8.4.3 - ghc-8.4.4 diff --git a/appveyor.yml b/appveyor.yml index 88165d419..e45e2ca10 100644 --- a/appveyor.yml +++ b/appveyor.yml @@ -7,7 +7,6 @@ environment: - GHCVER: 8.4.4 - GHCVER: 8.4.3 - GHCVER: 8.4.2 - - GHCVER: 8.2.2 install: - cmd: >- git submodule update --init --recursive diff --git a/stack-8.2.2.yaml b/stack-8.2.2.yaml deleted file mode 100644 index a36b72f07..000000000 --- a/stack-8.2.2.yaml +++ /dev/null @@ -1,48 +0,0 @@ -resolver: lts-11.18 # lts-11.x is the last one for GHC 8.2.2 -packages: -- . -- hie-plugin-api - -extra-deps: -- ./submodules/HaRe -- ./submodules/cabal-helper -- ./submodules/ghc-mod -- ./submodules/ghc-mod/core -- ./submodules/ghc-mod/ghc-project-types - -- brittany-0.12.0.0 -- butcher-1.3.1.1 -- cabal-plan-0.3.0.0 -- conduit-parse-0.2.1.0 -- constrained-dynamic-0.1.0.0 -- czipwith-1.0.1.0 -- floskell-0.10.0 -- ghc-exactprint-0.5.8.2 -- haddock-api-2.18.1 -- haddock-library-1.4.4 -- haskell-lsp-0.17.0.0 -- haskell-lsp-types-0.17.0.0 -- haskell-src-exts-1.21.0 -- haskell-src-exts-util-0.2.5 -- hlint-2.1.17 # last hlint supporting GHC 8.2 -- hoogle-5.0.17.9 -- hsimport-0.8.8 -- lsp-test-0.8.0.0 -- monad-dijkstra-0.1.1.2 -- pretty-show-1.8.2 -- rope-utf16-splay-0.3.1.0 -- sorted-list-0.2.1.0 -- syz-0.2.0.0 -# To make build work in windows 7 -- unix-time-0.4.7 - -flags: - haskell-ide-engine: - pedantic: true - hie-plugin-api: - pedantic: true - -nix: - packages: [ icu libcxx zlib ] - -concurrent-tests: false From 4d748f5d087c5441cf8c9b1c61bf99cf09b57cd9 Mon Sep 17 00:00:00 2001 From: fendor Date: Wed, 30 Oct 2019 10:25:01 +0100 Subject: [PATCH 04/67] Drop CPP directives guarding GHC 8.2.2 statements --- .../Haskell/Ide/Engine/ArtifactMap.hs | 4 --- hie-plugin-api/Haskell/Ide/Engine/Compat.hs | 28 +------------------ src/Haskell/Ide/Engine/Options.hs | 3 -- src/Haskell/Ide/Engine/Plugin/ApplyRefact.hs | 5 ---- src/Haskell/Ide/Engine/Plugin/Base.hs | 3 -- src/Haskell/Ide/Engine/Plugin/Build.hs | 6 ---- src/Haskell/Ide/Engine/Plugin/Example2.hs | 4 --- src/Haskell/Ide/Engine/Plugin/HaRe.hs | 4 --- src/Haskell/Ide/Engine/Plugin/Haddock.hs | 6 ---- src/Haskell/Ide/Engine/Plugin/Hoogle.hs | 4 --- src/Haskell/Ide/Engine/Plugin/Liquid.hs | 4 --- src/Haskell/Ide/Engine/Transport/JsonStdio.hs | 4 --- 12 files changed, 1 insertion(+), 74 deletions(-) diff --git a/hie-plugin-api/Haskell/Ide/Engine/ArtifactMap.hs b/hie-plugin-api/Haskell/Ide/Engine/ArtifactMap.hs index 95815811e..45f564659 100644 --- a/hie-plugin-api/Haskell/Ide/Engine/ArtifactMap.hs +++ b/hie-plugin-api/Haskell/Ide/Engine/ArtifactMap.hs @@ -92,11 +92,7 @@ genImportMap tm = moduleMap where (_, lImports, mlies, _) = fromJust $ GHC.tm_renamed_source tm -#if __GLASGOW_HASKELL__ > 802 lies = map fst $ fromMaybe [] mlies -#else - lies = fromMaybe [] mlies -#endif moduleMap :: ModuleMap moduleMap = foldl goImp IM.empty lImports `IM.union` foldl goExp IM.empty lies diff --git a/hie-plugin-api/Haskell/Ide/Engine/Compat.hs b/hie-plugin-api/Haskell/Ide/Engine/Compat.hs index fb172f72d..0f7d5322f 100644 --- a/hie-plugin-api/Haskell/Ide/Engine/Compat.hs +++ b/hie-plugin-api/Haskell/Ide/Engine/Compat.hs @@ -37,18 +37,12 @@ isExtensionOf ext = isSuffixOf ('.':ext) . takeExtensions #endif -#if MIN_VERSION_ghc(8, 4, 0) type GhcTc = GHC.GhcTc -#else -type GhcTc = GHC.Id -#endif pattern HsOverLitType :: Type.Type -> GHC.HsExpr GhcTc pattern HsOverLitType t <- #if MIN_VERSION_ghc(8, 6, 0) GHC.HsOverLit _ (GHC.overLitType -> t) -#elif MIN_VERSION_ghc(8, 4, 0) - GHC.HsOverLit (GHC.overLitType -> t) #else GHC.HsOverLit (GHC.overLitType -> t) #endif @@ -57,8 +51,6 @@ pattern HsLitType :: Type.Type -> GHC.HsExpr GhcTc pattern HsLitType t <- #if MIN_VERSION_ghc(8, 6, 0) GHC.HsLit _ (TcHsSyn.hsLitType -> t) -#elif MIN_VERSION_ghc(8, 4, 0) - GHC.HsLit (TcHsSyn.hsLitType -> t) #else GHC.HsLit (TcHsSyn.hsLitType -> t) #endif @@ -67,8 +59,6 @@ pattern HsLamType :: Type.Type -> GHC.HsExpr GhcTc pattern HsLamType t <- #if MIN_VERSION_ghc(8, 6, 0) GHC.HsLam _ ((\(GHC.MG { GHC.mg_ext = groupTy }) -> matchGroupType groupTy) -> t) -#elif MIN_VERSION_ghc(8, 4, 0) - GHC.HsLam (\GHC.MG { GHC.mg_res_ty = res, GHC.mg_arg_tys = args } -> Type.mkFunTys args res -> t) #else GHC.HsLam (\GHC.MG { GHC.mg_res_ty = res, GHC.mg_arg_tys = args } -> Type.mkFunTys args res -> t) #endif @@ -77,8 +67,6 @@ pattern HsLamCaseType :: Type.Type -> GHC.HsExpr GhcTc pattern HsLamCaseType t <- #if MIN_VERSION_ghc(8, 6, 0) GHC.HsLamCase _ ((\(GHC.MG { GHC.mg_ext = groupTy }) -> matchGroupType groupTy) -> t) -#elif MIN_VERSION_ghc(8, 4, 0) - GHC.HsLamCase (\GHC.MG { GHC.mg_res_ty = res, GHC.mg_arg_tys = args } -> Type.mkFunTys args res -> t) #else GHC.HsLamCase (\GHC.MG { GHC.mg_res_ty = res, GHC.mg_arg_tys = args } -> Type.mkFunTys args res -> t) #endif @@ -87,8 +75,6 @@ pattern HsCaseType :: Type.Type -> GHC.HsExpr GhcTc pattern HsCaseType t <- #if MIN_VERSION_ghc(8, 6, 0) GHC.HsCase _ _ ((\(GHC.MG { GHC.mg_ext = groupTy }) -> matchGroupType groupTy) -> t) -#elif MIN_VERSION_ghc(8, 4, 0) - GHC.HsCase _ (\GHC.MG { GHC.mg_res_ty = res, GHC.mg_arg_tys = args } -> Type.mkFunTys args res -> t) #else GHC.HsCase _ (\GHC.MG { GHC.mg_res_ty = res, GHC.mg_arg_tys = args } -> Type.mkFunTys args res -> t) #endif @@ -97,8 +83,6 @@ pattern ExplicitListType :: Type.Type -> GHC.HsExpr GhcTc pattern ExplicitListType t <- #if MIN_VERSION_ghc(8, 6, 0) GHC.ExplicitList (TysWiredIn.mkListTy -> t) _ _ -#elif MIN_VERSION_ghc(8, 4, 0) - GHC.ExplicitList (TysWiredIn.mkListTy -> t) _ _ #else GHC.ExplicitList (TysWiredIn.mkListTy -> t) _ _ #endif @@ -107,8 +91,6 @@ pattern ExplicitSumType :: Type.Type -> GHC.HsExpr GhcTc pattern ExplicitSumType t <- #if MIN_VERSION_ghc(8, 6, 0) GHC.ExplicitSum (TysWiredIn.mkSumTy -> t) _ _ _ -#elif MIN_VERSION_ghc(8, 4, 0) - GHC.ExplicitSum _ _ _ (TysWiredIn.mkSumTy -> t) #else GHC.ExplicitSum _ _ _ (TysWiredIn.mkSumTy -> t) #endif @@ -118,8 +100,6 @@ pattern HsMultiIfType :: Type.Type -> GHC.HsExpr GhcTc pattern HsMultiIfType t <- #if MIN_VERSION_ghc(8, 6, 0) GHC.HsMultiIf t _ -#elif MIN_VERSION_ghc(8, 4, 0) - GHC.HsMultiIf t _ #else GHC.HsMultiIf t _ #endif @@ -128,8 +108,6 @@ pattern FunBindType :: Type.Type -> GHC.HsBindLR GhcTc GhcTc pattern FunBindType t <- #if MIN_VERSION_ghc(8, 6, 0) GHC.FunBind _ (GHC.L _ (Var.varType -> t)) _ _ _ -#elif MIN_VERSION_ghc(8, 4, 0) - GHC.FunBind (GHC.L _ (Var.varType -> t)) _ _ _ _ #else GHC.FunBind (GHC.L _ (Var.varType -> t)) _ _ _ _ #endif @@ -138,8 +116,6 @@ pattern FunBindGen :: Type.Type -> GHC.MatchGroup GhcTc (GHC.LHsExpr GhcTc) -> G pattern FunBindGen t fmatches <- #if MIN_VERSION_ghc(8, 6, 0) GHC.FunBind _ (GHC.L _ (Var.varType -> t)) fmatches _ _ -#elif MIN_VERSION_ghc(8, 4, 0) - GHC.FunBind (GHC.L _ (Var.varType -> t)) fmatches _ _ _ #else GHC.FunBind (GHC.L _ (Var.varType -> t)) fmatches _ _ _ #endif @@ -148,10 +124,8 @@ pattern AbsBinds :: GHC.LHsBinds GhcTc -> GHC.HsBindLR GhcTc GhcTc pattern AbsBinds bs <- #if MIN_VERSION_ghc(8, 6, 0) GHC.AbsBinds _ _ _ _ _ bs _ -#elif MIN_VERSION_ghc(8, 4, 0) - GHC.AbsBinds _ _ _ _ bs _ #else - GHC.AbsBinds _ _ _ _ bs + GHC.AbsBinds _ _ _ _ bs _ #endif #if MIN_VERSION_ghc(8, 6, 0) diff --git a/src/Haskell/Ide/Engine/Options.hs b/src/Haskell/Ide/Engine/Options.hs index f1d823602..bf473f000 100644 --- a/src/Haskell/Ide/Engine/Options.hs +++ b/src/Haskell/Ide/Engine/Options.hs @@ -1,9 +1,6 @@ {-# LANGUAGE CPP #-} module Haskell.Ide.Engine.Options where -#if __GLASGOW_HASKELL__ < 804 -import Data.Semigroup hiding (option) -#endif import Options.Applicative.Simple data GlobalOpts = GlobalOpts diff --git a/src/Haskell/Ide/Engine/Plugin/ApplyRefact.hs b/src/Haskell/Ide/Engine/Plugin/ApplyRefact.hs index df848d0a9..ff1903728 100644 --- a/src/Haskell/Ide/Engine/Plugin/ApplyRefact.hs +++ b/src/Haskell/Ide/Engine/Plugin/ApplyRefact.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DuplicateRecordFields #-} @@ -27,11 +26,7 @@ import Haskell.Ide.Engine.PluginUtils import Language.Haskell.Exts.SrcLoc import Language.Haskell.Exts.Parser import Language.Haskell.Exts.Extension -#if (defined(MIN_VERSION_GLASGOW_HASKELL) && (MIN_VERSION_GLASGOW_HASKELL(8,4,0,0))) import Language.Haskell.HLint4 as Hlint -#else -import Language.Haskell.HLint3 as Hlint -#endif import qualified Language.Haskell.LSP.Types as LSP import qualified Language.Haskell.LSP.Types.Lens as LSP import Refact.Apply diff --git a/src/Haskell/Ide/Engine/Plugin/Base.hs b/src/Haskell/Ide/Engine/Plugin/Base.hs index 0d6ac7f98..df1d54b9d 100644 --- a/src/Haskell/Ide/Engine/Plugin/Base.hs +++ b/src/Haskell/Ide/Engine/Plugin/Base.hs @@ -11,9 +11,6 @@ import Data.Aeson import Data.Foldable import qualified Data.Map as Map import Data.Maybe -#if __GLASGOW_HASKELL__ < 804 -import Data.Semigroup -#endif import qualified Data.Text as T import qualified Data.Versions as V import Development.GitRev (gitCommitCount) diff --git a/src/Haskell/Ide/Engine/Plugin/Build.hs b/src/Haskell/Ide/Engine/Plugin/Build.hs index 724bc7738..91a711da2 100644 --- a/src/Haskell/Ide/Engine/Plugin/Build.hs +++ b/src/Haskell/Ide/Engine/Plugin/Build.hs @@ -13,13 +13,7 @@ module Haskell.Ide.Engine.Plugin.Build where #endif import qualified Data.Aeson as J -#if __GLASGOW_HASKELL__ < 802 -import qualified Data.Aeson.Types as J -#endif import Data.Maybe (fromMaybe) -#if __GLASGOW_HASKELL__ < 804 -import Data.Monoid -#endif import Control.Monad import Control.Monad.IO.Class import Control.Monad.Trans.Reader diff --git a/src/Haskell/Ide/Engine/Plugin/Example2.hs b/src/Haskell/Ide/Engine/Plugin/Example2.hs index 2a663727c..82a1d6680 100644 --- a/src/Haskell/Ide/Engine/Plugin/Example2.hs +++ b/src/Haskell/Ide/Engine/Plugin/Example2.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DuplicateRecordFields #-} @@ -9,9 +8,6 @@ import Control.Lens import Control.Monad.IO.Class import Data.Aeson import qualified Data.HashMap.Strict as H -#if __GLASGOW_HASKELL__ < 804 -import Data.Monoid -#endif import qualified Data.Map as Map import qualified Data.Set as S import qualified Data.Text as T diff --git a/src/Haskell/Ide/Engine/Plugin/HaRe.hs b/src/Haskell/Ide/Engine/Plugin/HaRe.hs index d5c02bb52..f465d4dbc 100644 --- a/src/Haskell/Ide/Engine/Plugin/HaRe.hs +++ b/src/Haskell/Ide/Engine/Plugin/HaRe.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} @@ -14,9 +13,6 @@ import qualified Data.Aeson.Types as J import Data.Algorithm.Diff import Data.Algorithm.DiffOutput import Data.Foldable -#if __GLASGOW_HASKELL__ < 804 -import Data.Monoid -#endif import qualified Data.Text as T import qualified Data.Text.IO as T import Exception diff --git a/src/Haskell/Ide/Engine/Plugin/Haddock.hs b/src/Haskell/Ide/Engine/Plugin/Haddock.hs index 7cbefc3cb..6ae1435f7 100644 --- a/src/Haskell/Ide/Engine/Plugin/Haddock.hs +++ b/src/Haskell/Ide/Engine/Plugin/Haddock.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE CPP #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RankNTypes #-} @@ -9,9 +8,6 @@ module Haskell.Ide.Engine.Plugin.Haddock where import Control.Monad.State import Data.Foldable import qualified Data.Map as Map -#if __GLASGOW_HASKELL__ < 804 -import Data.Monoid -#endif import qualified Data.Text as T import Data.IORef import Data.Function @@ -195,9 +191,7 @@ renderMarkDown = ["```\n"]) , markupHeader = \h -> T.replicate (headerLevel h) "#" <> " " <> headerTitle h <> "\n" -#if __GLASGOW_HASKELL__ >= 804 , markupTable = mempty -#endif } where surround c x = c <> T.replace c "" x <> c removeInner x = T.replace "```" "" $ T.replace "```haskell" "" x diff --git a/src/Haskell/Ide/Engine/Plugin/Hoogle.hs b/src/Haskell/Ide/Engine/Plugin/Hoogle.hs index 9030105c6..595aceda6 100644 --- a/src/Haskell/Ide/Engine/Plugin/Hoogle.hs +++ b/src/Haskell/Ide/Engine/Plugin/Hoogle.hs @@ -1,6 +1,5 @@ {-# LANGUAGE TupleSections #-} {-# LANGUAGE LambdaCase #-} -{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} module Haskell.Ide.Engine.Plugin.Hoogle where @@ -11,9 +10,6 @@ import Control.Applicative (liftA2) import Data.Aeson import Data.Bifunctor import Data.Maybe -#if __GLASGOW_HASKELL__ < 804 -import Data.Monoid -#endif import qualified Data.Text as T import Data.List import Haskell.Ide.Engine.MonadTypes diff --git a/src/Haskell/Ide/Engine/Plugin/Liquid.hs b/src/Haskell/Ide/Engine/Plugin/Liquid.hs index 5d01c854d..d2bbdf2cf 100644 --- a/src/Haskell/Ide/Engine/Plugin/Liquid.hs +++ b/src/Haskell/Ide/Engine/Plugin/Liquid.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE OverloadedStrings #-} @@ -10,9 +9,6 @@ import Control.Monad import Control.Monad.IO.Class import Control.Monad.Trans import Control.Exception (bracket) -#if __GLASGOW_HASKELL__ < 804 -import Data.Monoid -#endif import Data.Aeson import qualified Data.ByteString.Lazy as BS import qualified Data.Map as Map diff --git a/src/Haskell/Ide/Engine/Transport/JsonStdio.hs b/src/Haskell/Ide/Engine/Transport/JsonStdio.hs index c91dc6699..eb929a84e 100644 --- a/src/Haskell/Ide/Engine/Transport/JsonStdio.hs +++ b/src/Haskell/Ide/Engine/Transport/JsonStdio.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DuplicateRecordFields #-} @@ -21,9 +20,6 @@ import Control.Monad.IO.Class import qualified Data.Aeson as J import qualified Data.ByteString.Builder as B import qualified Data.ByteString.Lazy.Char8 as B -#if __GLASGOW_HASKELL__ < 804 -import Data.Monoid -#endif import qualified Data.Text as T import GHC.Generics import Haskell.Ide.Engine.PluginsIdeMonads From 2d39a8d2a40fc47fbc1de577626ae8b28f7106fc Mon Sep 17 00:00:00 2001 From: fendor Date: Wed, 30 Oct 2019 16:42:55 +0100 Subject: [PATCH 05/67] Remove old hlint dependency from cabal file --- haskell-ide-engine.cabal | 5 +---- 1 file changed, 1 insertion(+), 4 deletions(-) diff --git a/haskell-ide-engine.cabal b/haskell-ide-engine.cabal index a17abbbec..f55d52f4b 100644 --- a/haskell-ide-engine.cabal +++ b/haskell-ide-engine.cabal @@ -98,10 +98,7 @@ library , vector , versions , yaml >= 0.8.31 - if impl(ghc < 8.4) - build-depends: hlint >= 2.0.11 && < 2.1.18 - else - build-depends: hlint >= 2.2.2 + , hlint >= 2.2.2 ghc-options: -Wall -Wredundant-constraints if flag(pedantic) From 7cf1295a2804a527381331bb7b73d58255721edc Mon Sep 17 00:00:00 2001 From: fendor Date: Wed, 30 Oct 2019 18:27:02 +0100 Subject: [PATCH 06/67] Drop CPP directives for GHC 8.2.2 in test folder --- test/functional/FunctionalCodeActionsSpec.hs | 5 +-- test/unit/ApplyRefactPluginSpec.hs | 18 -------- test/unit/GhcModPluginSpec.hs | 13 ------ test/unit/PackagePluginSpec.hs | 46 +------------------- test/utils/TestUtils.hs | 6 --- 5 files changed, 2 insertions(+), 86 deletions(-) diff --git a/test/functional/FunctionalCodeActionsSpec.hs b/test/functional/FunctionalCodeActionsSpec.hs index 59b2c7db6..bfcb9e37a 100644 --- a/test/functional/FunctionalCodeActionsSpec.hs +++ b/test/functional/FunctionalCodeActionsSpec.hs @@ -1,5 +1,4 @@ {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE CPP #-} module FunctionalCodeActionsSpec where @@ -213,8 +212,6 @@ spec = describe "code actions" $ do ] ] describe "add package suggestions" $ do - -- Only execute this test with ghc 8.4.4, below seems to be broken in the package. -#if (defined(MIN_VERSION_GLASGOW_HASKELL) && (MIN_VERSION_GLASGOW_HASKELL(8,4,0,0))) it "adds to .cabal files" $ runSession hieCommand fullCaps "test/testdata/addPackageTest/cabal-exe" $ do doc <- openDoc "AddPackage.hs" "haskell" @@ -240,7 +237,7 @@ spec = describe "code actions" $ do contents <- getDocumentEdit . TextDocumentIdentifier =<< getDocUri "add-package-test.cabal" liftIO $ T.lines contents `shouldSatisfy` \x -> any (\l -> "text -any" `T.isSuffixOf` (x !! l)) [15, 16] -#endif + it "adds to hpack package.yaml files" $ runSession hieCommand fullCaps "test/testdata/addPackageTest/hpack-exe" $ do doc <- openDoc "app/Asdf.hs" "haskell" diff --git a/test/unit/ApplyRefactPluginSpec.hs b/test/unit/ApplyRefactPluginSpec.hs index ac5445f45..d70eae0ff 100644 --- a/test/unit/ApplyRefactPluginSpec.hs +++ b/test/unit/ApplyRefactPluginSpec.hs @@ -100,7 +100,6 @@ applyRefactSpec = do PublishDiagnosticsParams { _uri = filePath , _diagnostics = List -#if (defined(MIN_VERSION_GLASGOW_HASKELL) && (MIN_VERSION_GLASGOW_HASKELL(8,4,0,0))) [Diagnostic {_range = Range { _start = Position {_line = 12, _character = 23} , _end = Position {_line = 12, _character = 100000}} , _severity = Just DsInfo @@ -108,23 +107,6 @@ applyRefactSpec = do , _source = Just "hlint" , _message = T.pack filePathNoUri <> ":13:24: error:\n Operator applied to too few arguments: +\n data instance Sing (z :: (a :~: b)) where\n> SRefl :: Sing Refl +\n\n" , _relatedInformation = Nothing }]} -#elif (defined(MIN_VERSION_GLASGOW_HASKELL) && (MIN_VERSION_GLASGOW_HASKELL(8,2,2,0))) - [Diagnostic {_range = Range { _start = Position {_line = 13, _character = 0} - , _end = Position {_line = 13, _character = 100000}} - , _severity = Just DsInfo - , _code = Just (StringValue "parser") - , _source = Just "hlint" - , _message = "Parse error: virtual }\n data instance Sing (z :: (a :~: b)) where\n SRefl :: Sing Refl +\n> \n\n" - , _relatedInformation = Nothing }]} -#else - [Diagnostic {_range = Range { _start = Position {_line = 11, _character = 28} - , _end = Position {_line = 11, _character = 100000}} - , _severity = Just DsInfo - , _code = Just "parser" - , _source = Just "hlint" - , _message = "Parse error: :~:\n import Data.Type.Equality ((:~:) (..), (:~~:) (..))\n \n> data instance Sing (z :: (a :~: b)) where\n SRefl :: Sing Refl +\n\n" - , _relatedInformation = Nothing }]} -#endif testCommand testPlugins act "applyrefact" "lint" arg res -- --------------------------------- diff --git a/test/unit/GhcModPluginSpec.hs b/test/unit/GhcModPluginSpec.hs index dc46c8886..b98fa12a4 100644 --- a/test/unit/GhcModPluginSpec.hs +++ b/test/unit/GhcModPluginSpec.hs @@ -5,9 +5,6 @@ module GhcModPluginSpec where import Control.Exception import qualified Data.HashMap.Strict as H import qualified Data.Map as Map -#if __GLASGOW_HASKELL__ < 804 --- import Data.Monoid -#endif import qualified Data.Set as S import qualified Data.Text as T import Haskell.Ide.Engine.Ghc @@ -486,11 +483,6 @@ ghcmodSpec = , (Range (toPos (33, 15)) (toPos (33, 19)), "Int -> Test -> ShowS") , (Range (toPos (33, 15)) (toPos (33, 19)), "Test -> String") , (Range (toPos (33, 15)) (toPos (33, 19)), "[Test] -> ShowS") -#if (defined(MIN_VERSION_GLASGOW_HASKELL) && (MIN_VERSION_GLASGOW_HASKELL(8,4,0,0))) -#else - , (Range (toPos (33, 15)) (toPos (33, 19)), "Int -> Test -> ShowS") - , (Range (toPos (33, 15)) (toPos (33, 19)), "[Test] -> ShowS") -#endif ] testCommand testPlugins act "ghcmod" "type" arg res @@ -505,11 +497,6 @@ ghcmodSpec = [ (Range (toPos (33, 21)) (toPos (33, 23)), "(Test -> Test -> Bool) -> (Test -> Test -> Bool) -> Eq Test") , (Range (toPos (33, 21)) (toPos (33, 23)), "Test -> Test -> Bool") , (Range (toPos (33, 21)) (toPos (33, 23)), "Test -> Test -> Bool") -#if (defined(MIN_VERSION_GLASGOW_HASKELL) && (MIN_VERSION_GLASGOW_HASKELL(8,4,0,0))) -#else - , (Range (toPos (33, 21)) (toPos (33, 23)), "Test -> Test -> Bool") - , (Range (toPos (33, 21)) (toPos (33, 23)), "Test -> Test -> Bool") -#endif ] testCommand testPlugins act "ghcmod" "type" arg res diff --git a/test/unit/PackagePluginSpec.hs b/test/unit/PackagePluginSpec.hs index 2944958ce..5bc47d97d 100644 --- a/test/unit/PackagePluginSpec.hs +++ b/test/unit/PackagePluginSpec.hs @@ -64,7 +64,6 @@ packageSpec = do args = AddParams fp (fp "AddPackage.hs") "text" act = addCmd' args textEdits = -#if (defined(MIN_VERSION_GLASGOW_HASKELL) && (MIN_VERSION_GLASGOW_HASKELL(8,4,0,0))) List [ TextEdit (Range (Position 0 0) (Position 7 27)) $ T.concat [ "cabal-version: >=1.10\n" @@ -85,25 +84,6 @@ packageSpec = do , " text -any" ] ] -#else - List -- TODO: this seems to indicate that the command does nothing - [ TextEdit (Range (Position 0 0) (Position 7 27)) $ T.concat - [ "name: add-package-test\n" - , "version: 0.1.0.0\n" - , "cabal-version: >=1.10\n" - , "build-type: Simple\n" - , "license: BSD3\n" - , "maintainer: luke_lau@icloud.com\n" - , "author: Luke Lau\n" - , "extra-source-files:\n" - , " ChangeLog.md" - ] - , TextEdit (Range (Position 9 0) (Position 13 34)) $ T.concat - [ "executable AddPackage\n" - , " main-is: AddPackage.hs\n" - ] - ] -#endif res = IdeResultOk $ WorkspaceEdit (Just $ H.singleton uri textEdits) Nothing testCommand testPlugins act "package" "add" args res @@ -117,7 +97,6 @@ packageSpec = do args = AddParams fp (fp "AddPackage.hs") "text" act = addCmd' args textEdits = -#if (defined(MIN_VERSION_GLASGOW_HASKELL) && (MIN_VERSION_GLASGOW_HASKELL(8,4,0,0))) List [ TextEdit (Range (Position 0 0) (Position 7 27)) $ T.concat [ "cabal-version: >=1.10\n" @@ -139,29 +118,6 @@ packageSpec = do , " text -any" ] ] -#else - List - [ TextEdit (Range (Position 0 0) (Position 7 27)) $ T.concat - [ "name: add-package-test\n" - , "version: 0.1.0.0\n" - , "cabal-version: >=1.10\n" - , "build-type: Simple\n" - , "license: BSD3\n" - , "maintainer: luke_lau@icloud.com\n" - , "author: Luke Lau\n" - , "extra-source-files:\n" - , " ChangeLog.md" - ] - , TextEdit (Range (Position 10 0) (Position 13 34)) $ T.concat - [ " exposed-modules:\n" - , " AddPackage\n" - , " build-depends:\n" - , " base >=4.7 && <5,\n" - , " text -any\n" - , " default-language: Haskell2010\n" - ] - ] -#endif res = IdeResultOk $ WorkspaceEdit (Just $ H.singleton uri textEdits) Nothing testCommand testPlugins act "package" "add" args res @@ -239,7 +195,7 @@ packageSpec = do ] ] testCommand testPlugins act "package" "add" args res - + it "Do nothing on NoPackage" $ withCurrentDirectory (testdata "invalid") $ do diff --git a/test/utils/TestUtils.hs b/test/utils/TestUtils.hs index 571170fe8..233b2e977 100644 --- a/test/utils/TestUtils.hs +++ b/test/utils/TestUtils.hs @@ -151,12 +151,6 @@ stackYaml = "stack-8.4.3.yaml" #elif (defined(MIN_VERSION_GLASGOW_HASKELL) && (MIN_VERSION_GLASGOW_HASKELL(8,4,2,0))) "stack-8.4.2.yaml" -#elif (defined(MIN_VERSION_GLASGOW_HASKELL) && (MIN_VERSION_GLASGOW_HASKELL(8,2,2,0))) - "stack-8.2.2.yaml" -#elif __GLASGOW_HASKELL__ >= 802 - "stack-8.2.1.yaml" -#else - "stack-8.0.2.yaml" #endif logFilePath :: String From 2a6a1885cd1ba74ed105d95c5c0c0228dc630865 Mon Sep 17 00:00:00 2001 From: Luke Lau Date: Tue, 5 Nov 2019 16:36:45 +0000 Subject: [PATCH 07/67] Update LSP options for new haskell-lsp --- src/Haskell/Ide/Engine/Transport/LspStdio.hs | 6 ++---- 1 file changed, 2 insertions(+), 4 deletions(-) diff --git a/src/Haskell/Ide/Engine/Transport/LspStdio.hs b/src/Haskell/Ide/Engine/Transport/LspStdio.hs index 52aa4b137..07860e11d 100644 --- a/src/Haskell/Ide/Engine/Transport/LspStdio.hs +++ b/src/Haskell/Ide/Engine/Transport/LspStdio.hs @@ -966,16 +966,14 @@ syncOptions = J.TextDocumentSyncOptions hieOptions :: [T.Text] -> Core.Options hieOptions commandIds = def { Core.textDocumentSync = Just syncOptions - , Core.completionProvider = Just (J.CompletionOptions (Just True) (Just ["."])) + , Core.completionKinds = Just ["."] -- As of 2018-05-24, vscode needs the commands to be registered -- otherwise they will not be available as codeActions (will be -- silently ignored, despite UI showing to the contrary). -- -- Hopefully the end May 2018 vscode release will stabilise -- this, it is a major rework of the machinery anyway. - , Core.executeCommandProvider = Just (J.ExecuteCommandOptions (J.List commandIds)) - , Core.renameProvider = Just (J.RenameOptions (Just True)) - , Core.implementationProvider = Just (J.GotoOptionsStatic True) + , Core.executeCommandCommands = commandIds } From 05220f21056eac8db083b0d0691e441d59d9e513 Mon Sep 17 00:00:00 2001 From: jneira Date: Wed, 6 Nov 2019 12:06:32 +0100 Subject: [PATCH 08/67] Ignore the PATH fix if it is not set --- install/src/Stack.hs | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/install/src/Stack.hs b/install/src/Stack.hs index eef3126a6..df6e65f41 100644 --- a/install/src/Stack.hs +++ b/install/src/Stack.hs @@ -1,8 +1,10 @@ +{-# LANGUAGE ScopedTypeVariables #-} module Stack where import Development.Shake import Development.Shake.Command import Development.Shake.FilePath +import Control.Exception import Control.Monad import Data.List import System.Directory ( copyFile ) @@ -102,7 +104,9 @@ stackBuildFailMsg = -- |Run actions without the stack cached binaries withoutStackCachedBinaries :: Action a -> Action a withoutStackCachedBinaries action = do - mbPath <- liftIO (lookupEnv "PATH") + mbPath <- liftIO (catch + (lookupEnv "PATH") + (\(_ :: SomeException) -> return Nothing)) case (mbPath, isRunFromStack) of From 4cfe6779bfb70224ec9d3dc37726b3d6ab6b7f4d Mon Sep 17 00:00:00 2001 From: jneira Date: Wed, 6 Nov 2019 13:44:50 +0100 Subject: [PATCH 09/67] Catch IOException instead SomeException --- install/src/Stack.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/install/src/Stack.hs b/install/src/Stack.hs index df6e65f41..f180e7121 100644 --- a/install/src/Stack.hs +++ b/install/src/Stack.hs @@ -106,7 +106,7 @@ withoutStackCachedBinaries :: Action a -> Action a withoutStackCachedBinaries action = do mbPath <- liftIO (catch (lookupEnv "PATH") - (\(_ :: SomeException) -> return Nothing)) + (\(_ :: IOException) -> return Nothing)) case (mbPath, isRunFromStack) of From a1b2f8c5d878174150262f95d661b9df61aff240 Mon Sep 17 00:00:00 2001 From: Alan Zimmerman Date: Wed, 6 Nov 2019 21:31:05 +0000 Subject: [PATCH 10/67] Make sure the liquid haskell test files are generated for unit-test We must run the liquid exe to generate results to be parsed. --- src/Haskell/Ide/Engine/Plugin/Liquid.hs | 13 +++++++++++-- test/unit/LiquidSpec.hs | 24 ++++++++++++------------ 2 files changed, 23 insertions(+), 14 deletions(-) diff --git a/src/Haskell/Ide/Engine/Plugin/Liquid.hs b/src/Haskell/Ide/Engine/Plugin/Liquid.hs index d2bbdf2cf..4868a7704 100644 --- a/src/Haskell/Ide/Engine/Plugin/Liquid.hs +++ b/src/Haskell/Ide/Engine/Plugin/Liquid.hs @@ -166,10 +166,19 @@ runLiquidHaskell fp = do cp = (shell cmd) { cwd = Just dir } -- logm $ "runLiquidHaskell:cmd=[" ++ cmd ++ "]" mpp <- lookupEnv "GHC_PACKAGE_PATH" + mge <- lookupEnv "GHC_ENVIRONMENT" -- logm $ "runLiquidHaskell:mpp=[" ++ show mpp ++ "]" + -- env <- getEnvironment + -- logm $ "runLiquidHaskell:env=[" ++ show env ++ "]" (ec,o,e) <- bracket - (unsetEnv "GHC_PACKAGE_PATH") - (\_ -> mapM_ (setEnv "GHC_PACKAGE_PATH") mpp) + (do + unsetEnv "GHC_ENVIRONMENT" + unsetEnv "GHC_PACKAGE_PATH" + ) + (\_ -> do + mapM_ (setEnv "GHC_PACKAGE_PATH") mpp + mapM_ (setEnv "GHC_ENVIRONMENT" ) mge + ) (\_ -> readCreateProcessWithExitCode cp "") -- logm $ "runLiquidHaskell:v=" ++ show (ec,o,e) return $ Just (ec,[o,e]) diff --git a/test/unit/LiquidSpec.hs b/test/unit/LiquidSpec.hs index 2acafe4fd..5ce3bd07e 100644 --- a/test/unit/LiquidSpec.hs +++ b/test/unit/LiquidSpec.hs @@ -3,6 +3,7 @@ module LiquidSpec where import Data.Aeson +import Data.List import qualified Data.ByteString.Lazy as BS import qualified Data.Text as T import qualified Data.Text.IO as T @@ -11,8 +12,10 @@ import Data.Maybe (isJust) import Haskell.Ide.Engine.MonadTypes import Haskell.Ide.Engine.Plugin.Liquid import System.Directory +import System.Exit import System.FilePath import Test.Hspec +import Control.Monad.IO.Class main :: IO () main = hspec spec @@ -28,18 +31,15 @@ spec = do -- --------------------------------- - -- AZ: this test has been moved to func-tests, stack > 2.1 sets - -- its own package environment, we can't run it from here. - - -- -- This produces some products in /test/testdata/liquid/.liquid/ that is used in subsequent test - -- it "runs the liquid haskell exe" $ do - -- let - -- fp = cwd "test/testdata/liquid/Evens.hs" - -- -- fp = "/home/alanz/tmp/haskell-proc-play/Evens.hs" - -- -- uri = filePathToUri fp - -- Just (ef, (msg:_)) <- runLiquidHaskell fp - -- msg `shouldSatisfy` isPrefixOf "RESULT\n[{\"start\":{\"line\":9,\"column\":1},\"stop\":{\"line\":9,\"column\":8},\"message\":\"Error: Liquid Type Mismatch\\n Inferred type\\n VV : {v : Int | v == (7 : int)}\\n \\n not a subtype of Required type\\n VV : {VV : Int | VV mod 2 == 0}\\n" - -- ef `shouldBe` ExitFailure 1 + -- This produces some products in /test/testdata/liquid/.liquid/ + -- that are used in subsequent test + it "runs the liquid haskell exe" $ do + let + fp = cwd "test/testdata/liquid/Evens.hs" + Just (ef, (msg:_)) <- runLiquidHaskell fp + liftIO $ putStrLn $ "msg=" ++ msg + msg `shouldSatisfy` isPrefixOf "RESULT\n[{\"start\":{\"line\"" + ef `shouldBe` ExitFailure 1 -- --------------------------------- it "gets annot file paths" $ do From e3fa4383643067e2b7bf6b5b08b230b059d687ce Mon Sep 17 00:00:00 2001 From: Matthew Pickering Date: Wed, 6 Nov 2019 21:54:44 +0000 Subject: [PATCH 11/67] Deal properly with increased GHC verbosity. Before it would make vscode freeze trying to output 100s of messages. --- hie-plugin-api/Haskell/Ide/Engine/Ghc.hs | 31 +++++++++++++++--------- 1 file changed, 19 insertions(+), 12 deletions(-) diff --git a/hie-plugin-api/Haskell/Ide/Engine/Ghc.hs b/hie-plugin-api/Haskell/Ide/Engine/Ghc.hs index fc55f0f20..6fc797503 100644 --- a/hie-plugin-api/Haskell/Ide/Engine/Ghc.hs +++ b/hie-plugin-api/Haskell/Ide/Engine/Ghc.hs @@ -174,18 +174,25 @@ logDiag :: (FilePath -> FilePath) -> IORef AdditionalErrs -> IORef Diagnostics - logDiag rfm eref dref df reason sev spn style msg = do eloc <- srcSpan2Loc rfm spn debugm $ "Diagnostics at Location: " <> show (spn, eloc) - let msgTxt = T.pack $ renderWithStyle df msg style - case eloc of - Right (Location uri range) -> do - let update = Map.insertWith Set.union (toNormalizedUri uri) l - where l = Set.singleton diag - diag = Diagnostic range (Just $ lspSev reason sev) Nothing (Just "bios") msgTxt Nothing - debugm $ "Writing diag " <> (show diag) - modifyIORef' dref (\(Diagnostics u) -> Diagnostics (update u)) - Left _ -> do - debugm $ "Writing err " <> (show msgTxt) - modifyIORef' eref (msgTxt:) - return () + let msgString = renderWithStyle df msg style + msgTxt = T.pack msgString + case sev of + SevOutput -> debugm msgString + SevDump -> debugm msgString + SevInfo -> debugm msgString + _ -> do + logm (show sev) + case eloc of + Right (Location uri range) -> do + let update = Map.insertWith Set.union (toNormalizedUri uri) l + where l = Set.singleton diag + diag = Diagnostic range (Just $ lspSev reason sev) Nothing (Just "bios") msgTxt Nothing + debugm $ "Writing diag " <> (show diag) + modifyIORef' dref (\(Diagnostics u) -> Diagnostics (update u)) + Left _ -> do + debugm $ "Writing err " <> (show msgTxt) + modifyIORef' eref (msgTxt:) + return () errorHandlers :: (String -> m a) -> (HscTypes.SourceError -> m a) -> [ErrorHandler m a] From 3bfd9655556fb6923db303088b7b86a192421b5a Mon Sep 17 00:00:00 2001 From: Matthew Pickering Date: Wed, 6 Nov 2019 21:58:33 +0000 Subject: [PATCH 12/67] Add eventlog tracing for ghc-events-analyse --- haskell-ide-engine.cabal | 2 +- hie-plugin-api/Haskell/Ide/Engine/Ghc.hs | 9 +++- src/Haskell/Ide/Engine/LSP/CodeActions.hs | 4 +- src/Haskell/Ide/Engine/LSP/Reactor.hs | 9 ++-- src/Haskell/Ide/Engine/Scheduler.hs | 23 ++++++++-- src/Haskell/Ide/Engine/Transport/JsonStdio.hs | 2 +- src/Haskell/Ide/Engine/Transport/LspStdio.hs | 43 ++++++++++--------- src/Haskell/Ide/Engine/Types.hs | 9 ++-- test/dispatcher/Main.hs | 4 +- test/plugin-dispatcher/Main.hs | 10 ++--- 10 files changed, 70 insertions(+), 45 deletions(-) diff --git a/haskell-ide-engine.cabal b/haskell-ide-engine.cabal index 1dd3ea349..c32ddfda9 100644 --- a/haskell-ide-engine.cabal +++ b/haskell-ide-engine.cabal @@ -122,7 +122,7 @@ executable hie , hslogger , optparse-simple ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall -Wredundant-constraints - -with-rtsopts=-T + -with-rtsopts=-T -eventlog if flag(pedantic) ghc-options: -Werror default-language: Haskell2010 diff --git a/hie-plugin-api/Haskell/Ide/Engine/Ghc.hs b/hie-plugin-api/Haskell/Ide/Engine/Ghc.hs index 6fc797503..e34affbb3 100644 --- a/hie-plugin-api/Haskell/Ide/Engine/Ghc.hs +++ b/hie-plugin-api/Haskell/Ide/Engine/Ghc.hs @@ -16,6 +16,8 @@ module Haskell.Ide.Engine.Ghc , makeRevRedirMapFunc ) where +import Debug.Trace + import Bag import Control.Monad.IO.Class import Control.Monad ( when ) @@ -219,13 +221,16 @@ errorHandlers ghcErrRes renderSourceError = handlers -- | Load a module from a filepath into the cache, first check the cache -- to see if it's already there. setTypecheckedModule :: Uri -> IdeGhcM (IdeResult (Diagnostics, AdditionalErrs)) -setTypecheckedModule uri = +setTypecheckedModule uri = do + liftIO $ traceEventIO ("START typecheck" ++ show uri) pluginGetFile "setTypecheckedModule: " uri $ \_fp -> do debugm "setTypecheckedModule: before ghc-mod" debugm "Loading file" -- mapped_fp <- persistVirtualFile uri -- ifCachedModuleM mapped_fp (setTypecheckedModule_load uri) cont - setTypecheckedModule_load uri + res <- setTypecheckedModule_load uri + liftIO $ traceEventIO ("STOP typecheck" ++ show uri) + return res -- Hacky, need to copy hs-boot file if one exists for a module -- This is because the virtual file gets created at VFS-1234.hs and diff --git a/src/Haskell/Ide/Engine/LSP/CodeActions.hs b/src/Haskell/Ide/Engine/LSP/CodeActions.hs index 00b20c897..c0ac387c7 100644 --- a/src/Haskell/Ide/Engine/LSP/CodeActions.hs +++ b/src/Haskell/Ide/Engine/LSP/CodeActions.hs @@ -42,9 +42,9 @@ handleCodeActionReq tn req = do providersCb providers = let reqs = map (\f -> lift (f docId range context)) providers - in makeRequests reqs tn (req ^. J.id) (send . filter wasRequested . concat) + in makeRequests reqs "code-actions" tn (req ^. J.id) (send . filter wasRequested . concat) - makeRequest (IReq tn (req ^. J.id) providersCb getProviders) + makeRequest (IReq tn "code-actions" (req ^. J.id) providersCb getProviders) where params = req ^. J.params diff --git a/src/Haskell/Ide/Engine/LSP/Reactor.hs b/src/Haskell/Ide/Engine/LSP/Reactor.hs index acdb382db..f17105962 100644 --- a/src/Haskell/Ide/Engine/LSP/Reactor.hs +++ b/src/Haskell/Ide/Engine/LSP/Reactor.hs @@ -124,15 +124,16 @@ cancelRequest lid = -- | Execute multiple ide requests sequentially makeRequests :: [IdeDeferM (IdeResult a)] -- ^ The requests to make + -> String -> TrackingNumber -> J.LspId -> ([a] -> R ()) -- ^ Callback with the request inputs and results -> R () makeRequests = go [] where - go acc [] _ _ callback = callback acc - go acc (x : xs) tn reqId callback = - let reqCallback result = go (acc ++ [result]) xs tn reqId callback - in makeRequest $ IReq tn reqId reqCallback x + go acc [] _ _ _ callback = callback acc + go acc (x : xs) d tn reqId callback = + let reqCallback result = go (acc ++ [result]) xs d tn reqId callback + in makeRequest $ IReq tn d reqId reqCallback x -- --------------------------------------------------------------------- diff --git a/src/Haskell/Ide/Engine/Scheduler.hs b/src/Haskell/Ide/Engine/Scheduler.hs index 019efd522..04979fbce 100644 --- a/src/Haskell/Ide/Engine/Scheduler.hs +++ b/src/Haskell/Ide/Engine/Scheduler.hs @@ -5,6 +5,7 @@ {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE AllowAmbiguousTypes #-} module Haskell.Ide.Engine.Scheduler ( Scheduler , DocUpdate @@ -17,10 +18,12 @@ module Haskell.Ide.Engine.Scheduler , cancelRequest , makeRequest , updateDocumentRequest + , updateDocument ) where -import Control.Concurrent.Async ( race_ ) +import Control.Concurrent.Async +import GHC.Conc import qualified Control.Concurrent.STM as STM import Control.Monad.IO.Class ( liftIO , MonadIO @@ -46,6 +49,8 @@ import Haskell.Ide.Engine.Types import Haskell.Ide.Engine.MonadFunctions import Haskell.Ide.Engine.MonadTypes +import Debug.Trace + -- | A Scheduler is a coordinator between the two main processes the ide engine uses -- for responding to users requests. It accepts all of the requests and dispatches @@ -159,7 +164,12 @@ runScheduler Scheduler {..} errorHandler callbackHandler mlf = do ideDispatcher dEnv errorHandler callbackHandler ideChanOut - runGhcDisp `race_` runIdeDisp + withAsync runGhcDisp $ \a -> + withAsync runIdeDisp $ \b -> do + flip labelThread "ghc" $ asyncThreadId a + flip labelThread "ide" $ asyncThreadId b + waitEither_ a b + -- | Sends a request to the scheduler so that it can be dispatched to the handler @@ -261,7 +271,8 @@ ideDispatcher ideDispatcher env errorHandler callbackHandler pin = forever $ do debugm "ideDispatcher: top of loop" - (IdeRequest tn lid callback action) <- liftIO $ Channel.readChan pin + (IdeRequest tn d lid callback action) <- liftIO $ Channel.readChan pin + liftIO $ traceEventIO $ "START " ++ show tn ++ "ide:" ++ d debugm $ "ideDispatcher: got request " ++ show tn @@ -276,6 +287,8 @@ ideDispatcher env errorHandler callbackHandler pin = IdeResultOk x -> callbackHandler callback x IdeResultFail (IdeError _ msg _) -> errorHandler (Just lid) J.InternalError msg + + liftIO $ traceEventIO $ "STOP " ++ show tn ++ "ide:" ++ d where queueDeferred (Defer fp cacheCb) = lift $ modifyMTState $ \s -> let oldQueue = requestQueue s @@ -302,9 +315,10 @@ ghcDispatcher env@DispatcherEnv { docVersionTVar } errorHandler callbackHandler iniDynFlags <- getSessionDynFlags forever $ do debugm "ghcDispatcher: top of loop" - GhcRequest tn context mver mid callback def action <- liftIO + GhcRequest tn d context mver mid callback def action <- liftIO $ Channel.readChan pin debugm $ "ghcDispatcher:got request " ++ show tn ++ " with id: " ++ show mid + liftIO $ traceEventIO $ "START " ++ show tn ++ "ghc:" ++ d let runner :: a -> IdeGhcM a -> IdeGhcM (IdeResult a) @@ -347,6 +361,7 @@ ghcDispatcher env@DispatcherEnv { docVersionTVar } errorHandler callbackHandler Just lid -> unlessCancelled env lid errorHandler $ do liftIO $ completedReq env lid runIfVersionMatch + liftIO $ traceEventIO $ "STOP " ++ show tn ++ "ghc:" ++ d -- | Runs the passed monad only if the request identified by the passed LspId -- has not already been cancelled. diff --git a/src/Haskell/Ide/Engine/Transport/JsonStdio.hs b/src/Haskell/Ide/Engine/Transport/JsonStdio.hs index 2a007b17e..c0c8b9e9e 100644 --- a/src/Haskell/Ide/Engine/Transport/JsonStdio.hs +++ b/src/Haskell/Ide/Engine/Transport/JsonStdio.hs @@ -99,7 +99,7 @@ run scheduler = flip E.catches handlers $ do case mreq of Nothing -> return() Just req -> do - let preq = GReq 0 (context req) Nothing (Just $ J.IdInt rid) (liftIO . callback) (toDynJSON (Nothing :: Maybe ())) + let preq = GReq 0 "" (context req) Nothing (Just $ J.IdInt rid) (liftIO . callback) (toDynJSON (Nothing :: Maybe ())) $ runPluginCommand (plugin req) (command req) (arg req) rid = reqId req callback = sendResponse rid . dynToJSON diff --git a/src/Haskell/Ide/Engine/Transport/LspStdio.hs b/src/Haskell/Ide/Engine/Transport/LspStdio.hs index 926607f68..67c3976f6 100644 --- a/src/Haskell/Ide/Engine/Transport/LspStdio.hs +++ b/src/Haskell/Ide/Engine/Transport/LspStdio.hs @@ -68,6 +68,7 @@ import System.FilePath (()) import System.Exit import qualified System.Log.Logger as L import qualified Data.Rope.UTF16 as Rope +import GHC.Conc -- --------------------------------------------------------------------- {-# ANN module ("hlint: ignore Eta reduce" :: String) #-} @@ -154,9 +155,9 @@ run scheduler _origDir plugins captureFp = flip E.catches handlers $ do -- haskell lsp sets the current directory to the project root in the InitializeRequest -- We launch the dispatcher after that so that the default cradle is -- recognized properly by ghc-mod - _ <- forkIO $ Scheduler.runScheduler scheduler errorHandler callbackHandler (Just lf) - _ <- forkIO reactorFunc - _ <- forkIO $ diagnosticsQueue tr + flip labelThread "scheduler" =<< (forkIO $ Scheduler.runScheduler scheduler errorHandler callbackHandler (Just lf)) + flip labelThread "reactor" =<< (forkIO reactorFunc) + flip labelThread "diagnostics" =<< (forkIO $ diagnosticsQueue tr) return Nothing diagnosticProviders :: Map.Map DiagnosticTrigger [(PluginId,DiagnosticProviderFunc)] @@ -439,7 +440,7 @@ reactor inp diagIn = do lf <- ask - let hreq = GReq tn Nothing Nothing Nothing callback Nothing $ IdeResultOk <$> Hoogle.initializeHoogleDb + let hreq = GReq tn "init-hoogle" Nothing Nothing Nothing callback Nothing $ IdeResultOk <$> Hoogle.initializeHoogleDb callback Nothing = flip runReaderT lf $ reactorSend $ NotShowMessage $ fmServerShowMessageNotification J.MtWarning "No hoogle db found. Check the README for instructions to generate one" @@ -512,7 +513,7 @@ reactor inp diagIn = do let uri = notification ^. J.params . J.textDocument . J.uri -- unmapFileFromVfs versionTVar cin uri - makeRequest $ GReq tn (Just uri) Nothing Nothing (const $ return ()) () $ do + makeRequest $ GReq tn "delete-cache" (Just uri) Nothing Nothing (const $ return ()) () $ do forM_ (uriToFilePath uri) deleteCachedModule return $ IdeResultOk () @@ -524,7 +525,7 @@ reactor inp diagIn = do let (params, doc, pos) = reqParams req newName = params ^. J.newName callback = reactorSend . RspRename . Core.makeResponseMessage req - let hreq = GReq tn (Just doc) Nothing (Just $ req ^. J.id) callback mempty + let hreq = GReq tn "HaRe-rename" (Just doc) Nothing (Just $ req ^. J.id) callback mempty $ HaRe.renameCmd' doc pos newName makeRequest hreq @@ -554,7 +555,7 @@ reactor inp diagIn = do in reactorSend $ RspHover $ Core.makeResponseMessage req h hreq :: PluginRequest R - hreq = IReq tn (req ^. J.id) callback $ + hreq = IReq tn "hover" (req ^. J.id) callback $ sequence <$> mapM (\hp -> lift $ hp doc pos) hps makeRequest hreq liftIO $ U.logs "reactor:HoverRequest done" @@ -624,7 +625,7 @@ reactor inp diagIn = do "Invalid fallbackCodeAction params" -- Just an ordinary HIE command Just (plugin, cmd) -> - let preq = GReq tn Nothing Nothing (Just $ req ^. J.id) callback (toDynJSON (Nothing :: Maybe J.WorkspaceEdit)) + let preq = GReq tn "plugin" Nothing Nothing (Just $ req ^. J.id) callback (toDynJSON (Nothing :: Maybe J.WorkspaceEdit)) $ runPluginCommand plugin cmd cmdParams in makeRequest preq @@ -654,7 +655,7 @@ reactor inp diagIn = do Nothing -> callback [] Just prefix -> do snippets <- Completions.WithSnippets <$> configVal completionSnippetsOn - let hreq = IReq tn (req ^. J.id) callback + let hreq = IReq tn "completion" (req ^. J.id) callback $ lift $ Completions.getCompletions doc prefix snippets makeRequest hreq @@ -664,7 +665,7 @@ reactor inp diagIn = do callback res = do let rspMsg = Core.makeResponseMessage req $ res reactorSend $ RspCompletionItemResolve rspMsg - hreq = IReq tn (req ^. J.id) callback $ runIdeResultT $ do + hreq = IReq tn "completion" (req ^. J.id) callback $ runIdeResultT $ do lift $ lift $ Completions.resolveCompletion origCompl makeRequest hreq @@ -674,7 +675,7 @@ reactor inp diagIn = do liftIO $ U.logs $ "reactor:got DocumentHighlightsRequest:" ++ show req let (_, doc, pos) = reqParams req callback = reactorSend . RspDocumentHighlights . Core.makeResponseMessage req . J.List - let hreq = IReq tn (req ^. J.id) callback + let hreq = IReq tn "highlights" (req ^. J.id) callback $ Hie.getReferencesInDoc doc pos makeRequest hreq @@ -686,7 +687,7 @@ reactor inp diagIn = do doc = params ^. J.textDocument . J.uri pos = params ^. J.position callback = reactorSend . RspDefinition . Core.makeResponseMessage req - let hreq = IReq tn (req ^. J.id) callback + let hreq = IReq tn "find-def" (req ^. J.id) callback $ fmap J.MultiLoc <$> Hie.findDef doc pos makeRequest hreq @@ -696,7 +697,7 @@ reactor inp diagIn = do doc = params ^. J.textDocument . J.uri pos = params ^. J.position callback = reactorSend . RspTypeDefinition . Core.makeResponseMessage req - let hreq = IReq tn (req ^. J.id) callback + let hreq = IReq tn "type-def" (req ^. J.id) callback $ fmap J.MultiLoc <$> Hie.findTypeDef doc pos makeRequest hreq @@ -705,7 +706,7 @@ reactor inp diagIn = do -- TODO: implement project-wide references let (_, doc, pos) = reqParams req callback = reactorSend . RspFindReferences. Core.makeResponseMessage req . J.List - let hreq = IReq tn (req ^. J.id) callback + let hreq = IReq tn "references" (req ^. J.id) callback $ fmap (map (J.Location doc . (^. J.range))) <$> Hie.getReferencesInDoc doc pos makeRequest hreq @@ -719,7 +720,7 @@ reactor inp diagIn = do doc = params ^. J.textDocument . J.uri withDocumentContents (req ^. J.id) doc $ \text -> let callback = reactorSend . RspDocumentFormatting . Core.makeResponseMessage req . J.List - hreq = IReq tn (req ^. J.id) callback $ lift $ provider text doc FormatText (params ^. J.options) + hreq = IReq tn "format" (req ^. J.id) callback $ lift $ provider text doc FormatText (params ^. J.options) in makeRequest hreq -- ------------------------------- @@ -732,7 +733,7 @@ reactor inp diagIn = do withDocumentContents (req ^. J.id) doc $ \text -> let range = params ^. J.range callback = reactorSend . RspDocumentRangeFormatting . Core.makeResponseMessage req . J.List - hreq = IReq tn (req ^. J.id) callback $ lift $ provider text doc (FormatRange range) (params ^. J.options) + hreq = IReq tn "range-format" (req ^. J.id) callback $ lift $ provider text doc (FormatRange range) (params ^. J.options) in makeRequest hreq -- ------------------------------- @@ -757,7 +758,7 @@ reactor inp diagIn = do in [si] <> children callback = reactorSend . RspDocumentSymbols . Core.makeResponseMessage req . convertSymbols . concat - let hreq = IReq tn (req ^. J.id) callback (sequence <$> mapM (\f -> f uri) sps) + let hreq = IReq tn "symbols" (req ^. J.id) callback (sequence <$> mapM (\f -> f uri) sps) makeRequest hreq -- ------------------------------- @@ -886,10 +887,10 @@ requestDiagnostics DiagnosticsRequest{trigger, file, trackingNumber, documentVer let fakeId = J.IdString ("fake,remove:pid=" <> pid) -- TODO:AZ: IReq should take a Maybe LspId let reql = case ds of DiagnosticProviderSync dps -> - IReq trackingNumber fakeId callbackl + IReq trackingNumber "diagnostics" fakeId callbackl $ dps trigger file DiagnosticProviderAsync dpa -> - IReq trackingNumber fakeId pure + IReq trackingNumber "diagnostics-a" fakeId pure $ dpa trigger file callbackl -- This callback is used in R for the dispatcher normally, -- but also in IO if the plugin chooses to spawn an @@ -932,14 +933,14 @@ requestDiagnosticsNormal tn file mVer = do let sendHlint = hlintOn clientConfig when sendHlint $ do -- get hlint diagnostics - let reql = GReq tn (Just file) (Just (file,ver)) Nothing callbackl (PublishDiagnosticsParams file mempty) + let reql = GReq tn "apply-refact" (Just file) (Just (file,ver)) Nothing callbackl (PublishDiagnosticsParams file mempty) $ ApplyRefact.lintCmd' file callbackl (PublishDiagnosticsParams fp (List ds)) = sendOne "hlint" (J.toNormalizedUri fp, ds) makeRequest reql -- get GHC diagnostics and loads the typechecked module into the cache - let reqg = GReq tn (Just file) (Just (file,ver)) Nothing callbackg mempty + let reqg = GReq tn "typecheck" (Just file) (Just (file,ver)) Nothing callbackg mempty $ BIOS.setTypecheckedModule file callbackg (HIE.Diagnostics pd, errs) = do forM_ errs $ \e -> do diff --git a/src/Haskell/Ide/Engine/Types.hs b/src/Haskell/Ide/Engine/Types.hs index acca4fa8f..cfd38d35a 100644 --- a/src/Haskell/Ide/Engine/Types.hs +++ b/src/Haskell/Ide/Engine/Types.hs @@ -18,6 +18,7 @@ type TrackingNumber = Int -- | Requests are parametric in the monad m -- that their callback expects to be in. pattern GReq :: TrackingNumber + -> String -> Maybe Uri -> Maybe (Uri, Int) -> Maybe J.LspId @@ -25,15 +26,16 @@ pattern GReq :: TrackingNumber -> a1 -> IdeGhcM (IdeResult a1) -> PluginRequest m -pattern GReq a b c d e f g= Right (GhcRequest a b c d e f g) +pattern GReq a s b c d e f g = Right (GhcRequest a s b c d e f g) -pattern IReq :: TrackingNumber -> J.LspId -> RequestCallback m a -> IdeDeferM (IdeResult a) -> Either (IdeRequest m) b -pattern IReq a b c d = Left (IdeRequest a b c d) +pattern IReq :: TrackingNumber -> String -> J.LspId -> RequestCallback m a -> IdeDeferM (IdeResult a) -> Either (IdeRequest m) b +pattern IReq a s b c d = Left (IdeRequest a s b c d) type PluginRequest m = Either (IdeRequest m) (GhcRequest m) data GhcRequest m = forall a. GhcRequest { pinMsgNum :: TrackingNumber -- ^ Exists to facilitate logging/tracing + , pinDesc :: String -- ^ Description of the request for debugging , pinContext :: Maybe J.Uri , pinDocVer :: Maybe (J.Uri, Int) , pinLspReqId :: Maybe J.LspId @@ -44,6 +46,7 @@ data GhcRequest m = forall a. GhcRequest data IdeRequest m = forall a. IdeRequest { pureMsgNum :: TrackingNumber -- ^ Exists to facilitate logging/tracing + , pureDesc :: String , pureReqId :: J.LspId , pureReqCallback :: RequestCallback m a , pureReq :: IdeDeferM (IdeResult a) diff --git a/test/dispatcher/Main.hs b/test/dispatcher/Main.hs index 1fe3d13b3..860eb6398 100644 --- a/test/dispatcher/Main.hs +++ b/test/dispatcher/Main.hs @@ -101,7 +101,7 @@ dispatchGhcRequest tn uri ctx n scheduler lc plugin com arg = do logger :: RequestCallback IO DynamicJSON logger x = logToChan lc (ctx, Right x) - let req = GReq tn uri Nothing (Just (IdInt n)) logger (toDynJSON (Nothing :: Maybe ())) $ + let req = GReq tn "plugin-command" uri Nothing (Just (IdInt n)) logger (toDynJSON (Nothing :: Maybe ())) $ runPluginCommand plugin com (toJSON arg) sendRequest scheduler Nothing req @@ -114,8 +114,8 @@ dispatchIdeRequest tn ctx scheduler lc lid f = do logger :: (Typeable a, ToJSON a) => RequestCallback IO a logger x = logToChan lc (ctx, Right (toDynJSON x)) - let req = IReq tn lid logger f sendRequest scheduler Nothing req + let req = IReq tn "dispatch" lid logger f -- --------------------------------------------------------------------- diff --git a/test/plugin-dispatcher/Main.hs b/test/plugin-dispatcher/Main.hs index 6c8fc88b0..1463dbc28 100644 --- a/test/plugin-dispatcher/Main.hs +++ b/test/plugin-dispatcher/Main.hs @@ -34,11 +34,11 @@ newPluginSpec = do let defCallback = atomically . writeTChan outChan delayedCallback = \r -> threadDelay 10000 >> defCallback r - let req0 = GReq 0 Nothing Nothing (Just $ IdInt 0) (\_ -> return () :: IO ()) "none" $ return $ IdeResultOk $ T.pack "text0" - req1 = GReq 1 Nothing Nothing (Just $ IdInt 1) defCallback "none" $ return $ IdeResultOk $ T.pack "text1" - req2 = GReq 2 Nothing Nothing (Just $ IdInt 2) delayedCallback "none" $ return $ IdeResultOk $ T.pack "text2" - req3 = GReq 3 Nothing (Just (filePathToUri "test", 2)) Nothing defCallback "none" $ return $ IdeResultOk $ T.pack "text3" - req4 = GReq 4 Nothing Nothing (Just $ IdInt 3) defCallback "none" $ return $ IdeResultOk $ T.pack "text4" + let req0 = GReq 0 "0" Nothing Nothing (Just $ IdInt 0) (\_ -> return () :: IO ()) "none" $ return $ IdeResultOk $ T.pack "text0" + req1 = GReq 1 "1" Nothing Nothing (Just $ IdInt 1) defCallback $ return $ IdeResultOk "none" $ T.pack "text1" + req2 = GReq 2 "2" Nothing Nothing (Just $ IdInt 2) delayedCallback $ return "none" $ IdeResultOk $ T.pack "text2" + req3 = GReq 3 "3" Nothing (Just (filePathToUri "test", 2)) Nothing defCallback $ return $ IdeResultOk "none" $ T.pack "text3" + req4 = GReq 4 "4" Nothing Nothing (Just $ IdInt 3) defCallback $ return $ IdeResultOk "none" $ T.pack "text4" let makeReq = sendRequest scheduler Nothing From e0a30bf83ae7d4d495d65314b28ca6f8fff3ead0 Mon Sep 17 00:00:00 2001 From: Matthew Pickering Date: Wed, 6 Nov 2019 21:59:03 +0000 Subject: [PATCH 13/67] typo fix --- hie-plugin-api/Haskell/Ide/Engine/PluginsIdeMonads.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/hie-plugin-api/Haskell/Ide/Engine/PluginsIdeMonads.hs b/hie-plugin-api/Haskell/Ide/Engine/PluginsIdeMonads.hs index b46502454..8e12e62c4 100644 --- a/hie-plugin-api/Haskell/Ide/Engine/PluginsIdeMonads.hs +++ b/hie-plugin-api/Haskell/Ide/Engine/PluginsIdeMonads.hs @@ -346,7 +346,7 @@ getDiagnosticProvidersConfig c = Map.fromList [("applyrefact",hlintOn c) -- Monads -- --------------------------------------------------------------------- --- | IdeM that allows for interaction with the ghc-mod session +-- | IdeM that allows for interaction with the Ghc session type IdeGhcM = GhcT IdeM --instance GM.MonadIO (GhcT IdeM) where From d109948e417d398a4f2a9a9427f9ba8f0362755b Mon Sep 17 00:00:00 2001 From: Matthew Pickering Date: Wed, 6 Nov 2019 21:59:52 +0000 Subject: [PATCH 14/67] Remove mapFileFromVFS and some more refactoring in this area --- .../Haskell/Ide/Engine/PluginsIdeMonads.hs | 8 +--- src/Haskell/Ide/Engine/LSP/Reactor.hs | 6 +++ src/Haskell/Ide/Engine/Scheduler.hs | 28 +++++++------ src/Haskell/Ide/Engine/Transport/JsonStdio.hs | 2 +- src/Haskell/Ide/Engine/Transport/LspStdio.hs | 39 +++---------------- test/dispatcher/Main.hs | 4 +- test/plugin-dispatcher/Main.hs | 5 ++- 7 files changed, 36 insertions(+), 56 deletions(-) diff --git a/hie-plugin-api/Haskell/Ide/Engine/PluginsIdeMonads.hs b/hie-plugin-api/Haskell/Ide/Engine/PluginsIdeMonads.hs index 8e12e62c4..883129144 100644 --- a/hie-plugin-api/Haskell/Ide/Engine/PluginsIdeMonads.hs +++ b/hie-plugin-api/Haskell/Ide/Engine/PluginsIdeMonads.hs @@ -469,13 +469,7 @@ reverseFileMap = do -- but less likely to throw an error and rather give Nothing. getPersistedFile' :: Core.LspFuncs Config -> Uri -> IO (Maybe FilePath) getPersistedFile' lf uri = - Core.getVirtualFileFunc lf (toNormalizedUri uri) >>= \case - Just (VirtualFile _ _ (Just file)) -> do - return (Just file) - Just (VirtualFile _ _ Nothing) -> do - file <- persistVirtualFile' lf uri - return (Just file) - Nothing -> return Nothing + Just <$> persistVirtualFile' lf uri -- | Get the location of the virtual file persisted to the file system associated -- to the given Uri. diff --git a/src/Haskell/Ide/Engine/LSP/Reactor.hs b/src/Haskell/Ide/Engine/LSP/Reactor.hs index f17105962..f1e8dfdaf 100644 --- a/src/Haskell/Ide/Engine/LSP/Reactor.hs +++ b/src/Haskell/Ide/Engine/LSP/Reactor.hs @@ -9,6 +9,7 @@ module Haskell.Ide.Engine.LSP.Reactor , makeRequest , makeRequests , updateDocumentRequest + , updateDocument , cancelRequest , asksLspFuncs , getClientConfig @@ -116,6 +117,11 @@ updateDocumentRequest :: (MonadIO m, MonadReader REnv m) => Uri -> Int -> PluginRequest R -> m () updateDocumentRequest = Scheduler.updateDocumentRequest +updateDocument :: (MonadIO m, MonadReader REnv m) => Uri -> Int -> m () +updateDocument uri ver = do + re <- scheduler <$> ask + liftIO $ Scheduler.updateDocument re uri ver + -- | Marks a s requests as cencelled by its LspId cancelRequest :: (MonadIO m, MonadReader REnv m) => J.LspId -> m () cancelRequest lid = diff --git a/src/Haskell/Ide/Engine/Scheduler.hs b/src/Haskell/Ide/Engine/Scheduler.hs index 04979fbce..c574bb4f0 100644 --- a/src/Haskell/Ide/Engine/Scheduler.hs +++ b/src/Haskell/Ide/Engine/Scheduler.hs @@ -183,20 +183,13 @@ sendRequest :: forall m . Scheduler m -- ^ The scheduler to send the request to. - -> Maybe DocUpdate - -- ^ If not Nothing, the version for the given document is updated before dispatching. - -> PluginRequest m + -> PluginRequest m -- ^ The request to dispatch. -> IO () -sendRequest Scheduler {..} docUpdate req = do +sendRequest Scheduler {..} req = do let (ghcChanIn, _) = ghcChan (ideChanIn, _) = ideChan - case docUpdate of - Nothing -> pure () - Just (uri, ver) -> - STM.atomically $ STM.modifyTVar' documentVersions (Map.insert uri ver) - case req of Right ghcRequest@GhcRequest { pinLspReqId = Nothing } -> Channel.writeChan ghcChanIn ghcRequest @@ -227,7 +220,7 @@ makeRequest -> m () makeRequest req = do env <- ask - liftIO $ sendRequest (getScheduler env) Nothing req + liftIO $ sendRequest (getScheduler env) req -- | Updates the version of a document and then sends the request to be processed -- asynchronously. @@ -239,7 +232,20 @@ updateDocumentRequest -> m () updateDocumentRequest uri ver req = do env <- ask - liftIO $ sendRequest (getScheduler env) (Just (uri, ver)) req + let sched = (getScheduler env) + liftIO $ do + updateDocument sched uri ver + sendRequest sched req + +-- | Updates the version of a document and then sends the request to be processed +-- asynchronously. +updateDocument + :: Scheduler a + -> Uri + -> Int + -> IO () +updateDocument sched uri ver = + STM.atomically $ STM.modifyTVar' (documentVersions sched) (Map.insert uri ver) ------------------------------------------------------------------------------- -- Dispatcher diff --git a/src/Haskell/Ide/Engine/Transport/JsonStdio.hs b/src/Haskell/Ide/Engine/Transport/JsonStdio.hs index c0c8b9e9e..7edb9ed18 100644 --- a/src/Haskell/Ide/Engine/Transport/JsonStdio.hs +++ b/src/Haskell/Ide/Engine/Transport/JsonStdio.hs @@ -103,7 +103,7 @@ run scheduler = flip E.catches handlers $ do $ runPluginCommand (plugin req) (command req) (arg req) rid = reqId req callback = sendResponse rid . dynToJSON - Scheduler.sendRequest scheduler Nothing preq + Scheduler.sendRequest scheduler preq getNextReq :: IO (Maybe ReactorInput) getNextReq = do diff --git a/src/Haskell/Ide/Engine/Transport/LspStdio.hs b/src/Haskell/Ide/Engine/Transport/LspStdio.hs index 67c3976f6..95ce38bc1 100644 --- a/src/Haskell/Ide/Engine/Transport/LspStdio.hs +++ b/src/Haskell/Ide/Engine/Transport/LspStdio.hs @@ -217,30 +217,6 @@ getPrefixAtPos uri pos = do -- --------------------------------------------------------------------- -mapFileFromVfs :: (MonadIO m, MonadReader REnv m) - => TrackingNumber - -> J.VersionedTextDocumentIdentifier -> m () -mapFileFromVfs tn vtdi = do - let uri = vtdi ^. J.uri - ver = fromMaybe 0 (vtdi ^. J.version) - lf <- asks lspFuncs - vfsFunc <- asksLspFuncs Core.getVirtualFileFunc - mvf <- liftIO $ vfsFunc (J.toNormalizedUri uri) - case (mvf, uriToFilePath uri) of - (Just (VFS.VirtualFile _ _ _), Just _fp) -> do - -- let text' = Rope.toString yitext - -- text = "{-# LINE 1 \"" ++ fp ++ "\"#-}\n" <> text' - -- TODO: @fendor, better document that, why do we even have this? - -- We have it to cancel operations that would operate on stale file versions - -- Maybe NotDidCloseDocument should call it, too? - let req = GReq tn (Just uri) Nothing Nothing (const $ return ()) () - $ return (IdeResultOk ()) - - updateDocumentRequest uri ver req - _ <- liftIO $ getPersistedFile' lf uri - return () - (_, _) -> return () - -- TODO: generalise this and move it to GhcMod.ModuleLoader updatePositionMap :: Uri -> [J.TextDocumentContentChangeEvent] -> IdeGhcM (IdeResult ()) updatePositionMap uri changes = pluginGetFile "updatePositionMap: " uri $ \file -> @@ -456,10 +432,10 @@ reactor inp diagIn = do let td = notification ^. J.params . J.textDocument uri = td ^. J.uri - ver = Just $ td ^. J.version - mapFileFromVfs tn $ J.VersionedTextDocumentIdentifier uri ver + ver = td ^. J.version + updateDocument uri ver -- We want to execute diagnostics for a newly opened file as soon as possible - requestDiagnostics $ DiagnosticsRequest DiagnosticOnOpen tn uri ver + requestDiagnostics $ DiagnosticsRequest DiagnosticOnOpen tn uri (Just ver) -- ------------------------------- @@ -479,11 +455,9 @@ reactor inp diagIn = do let td = notification ^. J.params . J.textDocument uri = td ^. J.uri - -- ver = Just $ td ^. J.version - ver = Nothing - mapFileFromVfs tn $ J.VersionedTextDocumentIdentifier uri ver + updateDocument uri 0 -- don't debounce/queue diagnostics when saving - requestDiagnostics (DiagnosticsRequest DiagnosticOnSave tn uri ver) + requestDiagnostics (DiagnosticsRequest DiagnosticOnSave tn uri Nothing) -- ------------------------------- @@ -495,8 +469,7 @@ reactor inp diagIn = do uri = vtdi ^. J.uri ver = vtdi ^. J.version J.List changes = params ^. J.contentChanges - mapFileFromVfs tn vtdi - makeRequest $ GReq tn (Just uri) Nothing Nothing (const $ return ()) () $ + updateDocumentRequest uri (fromMaybe 0 ver) $ GReq tn "update-position" (Just uri) Nothing Nothing (const $ return ()) () $ -- Important - Call this before requestDiagnostics updatePositionMap uri changes diff --git a/test/dispatcher/Main.hs b/test/dispatcher/Main.hs index 860eb6398..a65b7d22c 100644 --- a/test/dispatcher/Main.hs +++ b/test/dispatcher/Main.hs @@ -103,7 +103,7 @@ dispatchGhcRequest tn uri ctx n scheduler lc plugin com arg = do let req = GReq tn "plugin-command" uri Nothing (Just (IdInt n)) logger (toDynJSON (Nothing :: Maybe ())) $ runPluginCommand plugin com (toJSON arg) - sendRequest scheduler Nothing req + sendRequest scheduler req dispatchIdeRequest :: (Typeable a, ToJSON a) @@ -114,8 +114,8 @@ dispatchIdeRequest tn ctx scheduler lc lid f = do logger :: (Typeable a, ToJSON a) => RequestCallback IO a logger x = logToChan lc (ctx, Right (toDynJSON x)) - sendRequest scheduler Nothing req let req = IReq tn "dispatch" lid logger f + sendRequest scheduler req -- --------------------------------------------------------------------- diff --git a/test/plugin-dispatcher/Main.hs b/test/plugin-dispatcher/Main.hs index 1463dbc28..421e0a73e 100644 --- a/test/plugin-dispatcher/Main.hs +++ b/test/plugin-dispatcher/Main.hs @@ -40,14 +40,15 @@ newPluginSpec = do req3 = GReq 3 "3" Nothing (Just (filePathToUri "test", 2)) Nothing defCallback $ return $ IdeResultOk "none" $ T.pack "text3" req4 = GReq 4 "4" Nothing Nothing (Just $ IdInt 3) defCallback $ return $ IdeResultOk "none" $ T.pack "text4" - let makeReq = sendRequest scheduler Nothing + let makeReq = sendRequest scheduler pid <- forkIO $ runScheduler scheduler (\_ _ _ -> return ()) (\f x -> f x) def - sendRequest scheduler (Just (filePathToUri "test", 3)) req0 + updateDocument scheduler (filePathToUri "test") 3 + sendRequest scheduler req0 makeReq req1 makeReq req2 cancelRequest scheduler (IdInt 2) From e8b4beefc47635d64d0a21cf7ae2104c101559bb Mon Sep 17 00:00:00 2001 From: Matthew Pickering Date: Wed, 6 Nov 2019 22:00:33 +0000 Subject: [PATCH 15/67] Fix version number back to 1.0 --- haskell-ide-engine.cabal | 2 +- hie-plugin-api/hie-plugin-api.cabal | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/haskell-ide-engine.cabal b/haskell-ide-engine.cabal index c32ddfda9..494d2af7a 100644 --- a/haskell-ide-engine.cabal +++ b/haskell-ide-engine.cabal @@ -1,5 +1,5 @@ name: haskell-ide-engine -version: 0.13.0.0 +version: 1.0.0.0 synopsis: Provide a common engine to power any Haskell IDE description: Please see README.md homepage: http://github.com/githubuser/haskell-ide-engine#readme diff --git a/hie-plugin-api/hie-plugin-api.cabal b/hie-plugin-api/hie-plugin-api.cabal index adbe689e9..e036a17ba 100644 --- a/hie-plugin-api/hie-plugin-api.cabal +++ b/hie-plugin-api/hie-plugin-api.cabal @@ -1,5 +1,5 @@ name: hie-plugin-api -version: 0.13.0.0 +version: 1.0.0.0 synopsis: Haskell IDE API for plugin communication license: BSD3 license-file: LICENSE From b0a01e7e1c72e9de9de63965c7f4c3e46b0a8025 Mon Sep 17 00:00:00 2001 From: Matthew Pickering Date: Wed, 6 Nov 2019 22:00:53 +0000 Subject: [PATCH 16/67] Track changes to haskell-lsp --- hie-plugin-api/Haskell/Ide/Engine/PluginUtils.hs | 2 +- src/Haskell/Ide/Engine/Transport/LspStdio.hs | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/hie-plugin-api/Haskell/Ide/Engine/PluginUtils.hs b/hie-plugin-api/Haskell/Ide/Engine/PluginUtils.hs index 501d04c5c..42282b911 100644 --- a/hie-plugin-api/Haskell/Ide/Engine/PluginUtils.hs +++ b/hie-plugin-api/Haskell/Ide/Engine/PluginUtils.hs @@ -279,7 +279,7 @@ readVFS :: (MonadIde m, MonadIO m) => Uri -> m (Maybe T.Text) readVFS uri = do mvf <- getVirtualFile uri case mvf of - Just (VirtualFile _ txt _) -> return $ Just (Rope.toText txt) + Just (VirtualFile _ txt) -> return $ Just (Rope.toText txt) Nothing -> return Nothing getRangeFromVFS :: (MonadIde m, MonadIO m) => Uri -> Range -> m (Maybe T.Text) diff --git a/src/Haskell/Ide/Engine/Transport/LspStdio.hs b/src/Haskell/Ide/Engine/Transport/LspStdio.hs index 95ce38bc1..ffe3b5faf 100644 --- a/src/Haskell/Ide/Engine/Transport/LspStdio.hs +++ b/src/Haskell/Ide/Engine/Transport/LspStdio.hs @@ -783,7 +783,7 @@ withDocumentContents reqId uri f = do (J.responseId reqId) J.InvalidRequest "Document was not open" - Just (VFS.VirtualFile _ txt _) -> f (Rope.toText txt) + Just (VFS.VirtualFile _ txt) -> f (Rope.toText txt) -- | Get the currently configured formatter provider. -- The currently configured formatter provider is defined in @Config@ by PluginId. From f581cd6127eb5b695d7eea67849a09f431d08729 Mon Sep 17 00:00:00 2001 From: jneira Date: Thu, 7 Nov 2019 08:05:47 +0100 Subject: [PATCH 17/67] Catch the specific IOException in the getEnv error handler --- install/src/Stack.hs | 9 ++++++--- 1 file changed, 6 insertions(+), 3 deletions(-) diff --git a/install/src/Stack.hs b/install/src/Stack.hs index f180e7121..9a58a16ae 100644 --- a/install/src/Stack.hs +++ b/install/src/Stack.hs @@ -10,6 +10,7 @@ import Data.List import System.Directory ( copyFile ) import System.FilePath ( searchPathSeparator, () ) import System.Environment ( lookupEnv, setEnv, getEnvironment ) +import System.IO.Error ( isDoesNotExistError ) import BuildSystem import Version import Print @@ -104,9 +105,11 @@ stackBuildFailMsg = -- |Run actions without the stack cached binaries withoutStackCachedBinaries :: Action a -> Action a withoutStackCachedBinaries action = do - mbPath <- liftIO (catch - (lookupEnv "PATH") - (\(_ :: IOException) -> return Nothing)) + + let getEnvErrorHandler e | isDoesNotExistError e = return Nothing + | otherwise = throwIO e + + mbPath <- liftIO (lookupEnv "PATH" `catch` getEnvErrorHandler) case (mbPath, isRunFromStack) of From b089c8b6b8b597a0f4ce06effdcd5b06fd7865dd Mon Sep 17 00:00:00 2001 From: jneira Date: Thu, 7 Nov 2019 09:29:39 +0100 Subject: [PATCH 18/67] Remove unused language extension --- install/src/Stack.hs | 1 - 1 file changed, 1 deletion(-) diff --git a/install/src/Stack.hs b/install/src/Stack.hs index 9a58a16ae..210d406e9 100644 --- a/install/src/Stack.hs +++ b/install/src/Stack.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE ScopedTypeVariables #-} module Stack where import Development.Shake From 9fc2dcc3746c4dcc60b2dc9ab4922e66daa6be4e Mon Sep 17 00:00:00 2001 From: Matthew Pickering Date: Thu, 7 Nov 2019 09:41:51 +0000 Subject: [PATCH 19/67] Revert "Track changes to haskell-lsp" This reverts commit b0a01e7e1c72e9de9de63965c7f4c3e46b0a8025. --- hie-plugin-api/Haskell/Ide/Engine/PluginUtils.hs | 2 +- src/Haskell/Ide/Engine/Transport/LspStdio.hs | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/hie-plugin-api/Haskell/Ide/Engine/PluginUtils.hs b/hie-plugin-api/Haskell/Ide/Engine/PluginUtils.hs index 42282b911..501d04c5c 100644 --- a/hie-plugin-api/Haskell/Ide/Engine/PluginUtils.hs +++ b/hie-plugin-api/Haskell/Ide/Engine/PluginUtils.hs @@ -279,7 +279,7 @@ readVFS :: (MonadIde m, MonadIO m) => Uri -> m (Maybe T.Text) readVFS uri = do mvf <- getVirtualFile uri case mvf of - Just (VirtualFile _ txt) -> return $ Just (Rope.toText txt) + Just (VirtualFile _ txt _) -> return $ Just (Rope.toText txt) Nothing -> return Nothing getRangeFromVFS :: (MonadIde m, MonadIO m) => Uri -> Range -> m (Maybe T.Text) diff --git a/src/Haskell/Ide/Engine/Transport/LspStdio.hs b/src/Haskell/Ide/Engine/Transport/LspStdio.hs index ffe3b5faf..95ce38bc1 100644 --- a/src/Haskell/Ide/Engine/Transport/LspStdio.hs +++ b/src/Haskell/Ide/Engine/Transport/LspStdio.hs @@ -783,7 +783,7 @@ withDocumentContents reqId uri f = do (J.responseId reqId) J.InvalidRequest "Document was not open" - Just (VFS.VirtualFile _ txt) -> f (Rope.toText txt) + Just (VFS.VirtualFile _ txt _) -> f (Rope.toText txt) -- | Get the currently configured formatter provider. -- The currently configured formatter provider is defined in @Config@ by PluginId. From 73fcf4b4f62168ff6e143ccf0d49f6cbc22af74a Mon Sep 17 00:00:00 2001 From: Matthew Pickering Date: Thu, 7 Nov 2019 09:59:17 +0000 Subject: [PATCH 20/67] Some documentation --- README.md | 20 ++++++++++++++++++++ hie-plugin-api/Haskell/Ide/Engine/Ghc.hs | 7 ++++--- 2 files changed, 24 insertions(+), 3 deletions(-) diff --git a/README.md b/README.md index c545ec174..fc06cd34d 100644 --- a/README.md +++ b/README.md @@ -808,4 +808,24 @@ the program. 6. Try using `h-i-e` as normal and then process the `*.eventlog` which will be created using `eventlog2html`. 7. Repeat the process again using different profiling options if you like. +#### Using `ghc-events-analyze` + +`haskell-ide-engine` contains the necessary tracing functions to work with [`ghc-events-analyze`](http://www.well-typed.com/blog/2014/02/ghc-events-analyze/). Each +request which is made will emit an event to the eventlog when it starts andcompletes. This way you +can see if there are any requests which are taking a long time to complete or are blocking. + +1. Make sure that `hie` is linked with the `-eventlog` option. This can be achieved by adding the flag +to the `ghc-options` field in the cabal file. +2. Run `hie` as normal but with the addition of `+RTS -l`. This will produce an eventlog called `hie.eventlog`. +3. Run `ghc-events-analyze` on the `hie.eventlog` file to produce the rendered SVG. Warning, this might take a while and produce a big SVG file. + +The default options for `ghc-events-analyze` will produce quite a wide chart which is difficult to view. You can try using less buckets in order +to make the chart quicker to generate and faster to render. + +``` +ghc-events-analyze hie.eventlog -b 100 +``` + +This support is similar to the logging capabilities [built into GHC](https://www.haskell.org/ghc/blog/20190924-eventful-ghc.html). + diff --git a/hie-plugin-api/Haskell/Ide/Engine/Ghc.hs b/hie-plugin-api/Haskell/Ide/Engine/Ghc.hs index e34affbb3..97488b52f 100644 --- a/hie-plugin-api/Haskell/Ide/Engine/Ghc.hs +++ b/hie-plugin-api/Haskell/Ide/Engine/Ghc.hs @@ -179,11 +179,14 @@ logDiag rfm eref dref df reason sev spn style msg = do let msgString = renderWithStyle df msg style msgTxt = T.pack msgString case sev of + -- These three verbosity levels are triggered by increasing verbosity. + -- Normally the verbosity is set to 0 when the session is initialised but + -- sometimes for debugging it is useful to override this and piping the messages + -- to the normal debugging framework means they just show up in the normal log. SevOutput -> debugm msgString SevDump -> debugm msgString SevInfo -> debugm msgString _ -> do - logm (show sev) case eloc of Right (Location uri range) -> do let update = Map.insertWith Set.union (toNormalizedUri uri) l @@ -226,8 +229,6 @@ setTypecheckedModule uri = do pluginGetFile "setTypecheckedModule: " uri $ \_fp -> do debugm "setTypecheckedModule: before ghc-mod" debugm "Loading file" - -- mapped_fp <- persistVirtualFile uri - -- ifCachedModuleM mapped_fp (setTypecheckedModule_load uri) cont res <- setTypecheckedModule_load uri liftIO $ traceEventIO ("STOP typecheck" ++ show uri) return res From 702a5f5fb226e4a0c586d59c55610c7572152036 Mon Sep 17 00:00:00 2001 From: Matthew Pickering Date: Thu, 7 Nov 2019 10:01:13 +0000 Subject: [PATCH 21/67] Fix profiling docs --- README.md | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/README.md b/README.md index fc06cd34d..ad92cf3eb 100644 --- a/README.md +++ b/README.md @@ -800,12 +800,12 @@ If you think `haskell-ide-engine` is using a lot of memory then the most useful thing you can do is prepare a profile of the memory usage whilst you're using the program. -1. Add `profiling: True` to the cabal.project file of `haskell-ide-engine +1. Add `profiling: True` to the cabal.project file of `haskell-ide-engine` 2. `cabal new-build hie` 3. (IMPORTANT) Add `profiling: True` to the `cabal.project` file of the project you want to profile. 4. Make a wrapper script which calls the `hie` you built in step 2 with the additional options `+RTS -hd -l-au` 5. Modify your editor settings to call this wrapper script instead of looking for `hie` on the path -6. Try using `h-i-e` as normal and then process the `*.eventlog` which will be created using `eventlog2html`. +6. Try using `h-i-e` as normal and then process the `*.eventlog` which will be created using [`eventlog2html`](http://hackage.haskell.org/package/eventlog2html). 7. Repeat the process again using different profiling options if you like. #### Using `ghc-events-analyze` From 1ca4e0abd3f569479148e760143c146a9284a102 Mon Sep 17 00:00:00 2001 From: Matthew Pickering Date: Thu, 7 Nov 2019 10:06:10 +0000 Subject: [PATCH 22/67] docs typo --- README.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/README.md b/README.md index ad92cf3eb..80d7ca135 100644 --- a/README.md +++ b/README.md @@ -811,7 +811,7 @@ the program. #### Using `ghc-events-analyze` `haskell-ide-engine` contains the necessary tracing functions to work with [`ghc-events-analyze`](http://www.well-typed.com/blog/2014/02/ghc-events-analyze/). Each -request which is made will emit an event to the eventlog when it starts andcompletes. This way you +request which is made will emit an event to the eventlog when it starts and finishes. This way you can see if there are any requests which are taking a long time to complete or are blocking. 1. Make sure that `hie` is linked with the `-eventlog` option. This can be achieved by adding the flag From 7a9b56342e425509f255d0826974c56e2a0dad5a Mon Sep 17 00:00:00 2001 From: Alan Zimmerman Date: Thu, 7 Nov 2019 23:30:28 +0000 Subject: [PATCH 23/67] Adapt liquid haskell tests for version 0.8.6.2 This needs https://github.com/alanz/haskell-dockerfiles/pull/2 for CI, to update the base image GHC and liquid haskell version. --- src/Haskell/Ide/Engine/Plugin/Liquid.hs | 2 +- test/functional/FunctionalLiquidSpec.hs | 9 +++++++-- test/unit/LiquidSpec.hs | 27 +++++++++++++++---------- 3 files changed, 24 insertions(+), 14 deletions(-) diff --git a/src/Haskell/Ide/Engine/Plugin/Liquid.hs b/src/Haskell/Ide/Engine/Plugin/Liquid.hs index 4868a7704..b00c1086f 100644 --- a/src/Haskell/Ide/Engine/Plugin/Liquid.hs +++ b/src/Haskell/Ide/Engine/Plugin/Liquid.hs @@ -164,7 +164,7 @@ runLiquidHaskell fp = do let cmd = lh ++ " --json \"" ++ fp ++ "\"" dir = takeDirectory fp cp = (shell cmd) { cwd = Just dir } - -- logm $ "runLiquidHaskell:cmd=[" ++ cmd ++ "]" + logm $ "runLiquidHaskell:cmd=[" ++ cmd ++ "]" mpp <- lookupEnv "GHC_PACKAGE_PATH" mge <- lookupEnv "GHC_ENVIRONMENT" -- logm $ "runLiquidHaskell:mpp=[" ++ show mpp ++ "]" diff --git a/test/functional/FunctionalLiquidSpec.hs b/test/functional/FunctionalLiquidSpec.hs index b1f7fc29e..1cac42bb9 100644 --- a/test/functional/FunctionalLiquidSpec.hs +++ b/test/functional/FunctionalLiquidSpec.hs @@ -98,11 +98,16 @@ spec = describe "liquid haskell diagnostics" $ do -- liftIO $ show diags3 `shouldBe` "" liftIO $ do length diags3 `shouldBe` 1 - d ^. range `shouldBe` Range (Position 8 0) (Position 8 7) + d ^. range `shouldBe` Range (Position 8 0) (Position 8 11) d ^. severity `shouldBe` Just DsError d ^. code `shouldBe` Nothing d ^. source `shouldBe` Just "liquid" - d ^. message `shouldSatisfy` (T.isPrefixOf "Error: Liquid Type Mismatch\n Inferred type\n VV : {v : Int | v == (7 : int)}\n \n not a subtype of Required type\n VV : {VV : Int | VV mod 2 == 0}\n") + d ^. message `shouldSatisfy` T.isPrefixOf ("Error: Liquid Type Mismatch\n" <> + " Inferred type\n" <> + " VV : {v : GHC.Types.Int | v == 7}\n" <> + " \n" <> + " not a subtype of Required type\n" <> + " VV : {VV : GHC.Types.Int | VV mod 2 == 0}\n ") -- --------------------------------------------------------------------- diff --git a/test/unit/LiquidSpec.hs b/test/unit/LiquidSpec.hs index 5ce3bd07e..cc8f0095d 100644 --- a/test/unit/LiquidSpec.hs +++ b/test/unit/LiquidSpec.hs @@ -15,7 +15,7 @@ import System.Directory import System.Exit import System.FilePath import Test.Hspec -import Control.Monad.IO.Class +-- import Control.Monad.IO.Class main :: IO () main = hspec spec @@ -37,8 +37,10 @@ spec = do let fp = cwd "test/testdata/liquid/Evens.hs" Just (ef, (msg:_)) <- runLiquidHaskell fp - liftIO $ putStrLn $ "msg=" ++ msg - msg `shouldSatisfy` isPrefixOf "RESULT\n[{\"start\":{\"line\"" + -- liftIO $ putStrLn $ "msg=" ++ msg + -- liftIO $ putStrLn $ "msg=" ++ unlines (drop 3 (lines msg)) + let msg' = unlines (drop 3 (lines msg)) + msg' `shouldSatisfy` isInfixOf "RESULT\n[{\"start\":{\"line\"" ef `shouldBe` ExitFailure 1 -- --------------------------------- @@ -60,12 +62,15 @@ spec = do let Just v = decode jf :: Maybe LiquidJson let [LE { start, stop, message }] = errors v start `shouldBe` LP 9 1 - stop `shouldBe` LP 9 8 + stop `shouldBe` LP 9 12 message `shouldSatisfy` T.isPrefixOf - ("Error: Liquid Type Mismatch\n Inferred type\n" <> - " VV : {v : Int | v == (7 : int)}\n \n" <> + ("Error: Liquid Type Mismatch\n" <> + " Inferred type\n" <> + " VV : {v : GHC.Types.Int | v == 7}\n" <> + " \n" <> " not a subtype of Required type\n" <> - " VV : {VV : Int | VV mod 2 == 0}\n") + " VV : {VV : GHC.Types.Int | VV mod 2 == 0}\n" <> + " ") -- --------------------------------- @@ -100,8 +105,8 @@ spec = do take 2 ts `shouldBe` [LE (LP 1 1) (LP 1 1) "GHC.Types.Module" - ,LE (LP 6 1) (LP 6 10) "[{v : GHC.Types.Int | v mod 2 == 0}]"] - length ts `shouldBe` 38 + ,LE (LP 6 1) (LP 6 10) "[{VV : GHC.Types.Int | VV mod 2 == 0}]"] + length ts `shouldBe` 53 -- --------------------------------- @@ -112,8 +117,8 @@ spec = do take 2 ts `shouldBe` [LE (LP 1 1) (LP 1 1) "GHC.Types.Module" - ,LE (LP 6 1) (LP 6 10) "[{v : GHC.Types.Int | v mod 2 == 0}]"] - length ts `shouldBe` 38 + ,LE (LP 6 1) (LP 6 10) "[{VV : GHC.Types.Int | VV mod 2 == 0}]"] + length ts `shouldBe` 53 -- --------------------------------- From d228c02d5bdb2395167b8c1b181c1550360f5eb6 Mon Sep 17 00:00:00 2001 From: Matthew Pickering Date: Fri, 8 Nov 2019 21:31:51 +0000 Subject: [PATCH 24/67] modifyModuleCache rather than setModuleCache --- hie-plugin-api/Haskell/Ide/Engine/GhcModuleCache.hs | 5 ++--- hie-plugin-api/Haskell/Ide/Engine/ModuleCache.hs | 7 ++++--- .../Haskell/Ide/Engine/PluginsIdeMonads.hs | 13 +++++-------- 3 files changed, 11 insertions(+), 14 deletions(-) diff --git a/hie-plugin-api/Haskell/Ide/Engine/GhcModuleCache.hs b/hie-plugin-api/Haskell/Ide/Engine/GhcModuleCache.hs index d10453038..493b2ef01 100644 --- a/hie-plugin-api/Haskell/Ide/Engine/GhcModuleCache.hs +++ b/hie-plugin-api/Haskell/Ide/Engine/GhcModuleCache.hs @@ -1,7 +1,6 @@ {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE TupleSections #-} module Haskell.Ide.Engine.GhcModuleCache where @@ -79,9 +78,9 @@ getThingsAtPos cm pos ts = -- --------------------------------------------------------------------- -- The following to move into ghc-mod-core -class (Monad m) => HasGhcModuleCache m where +class Monad m => HasGhcModuleCache m where getModuleCache :: m GhcModuleCache - setModuleCache :: GhcModuleCache -> m () + modifyModuleCache :: (GhcModuleCache -> GhcModuleCache) -> m () emptyModuleCache :: GhcModuleCache emptyModuleCache = GhcModuleCache T.empty Map.empty Nothing diff --git a/hie-plugin-api/Haskell/Ide/Engine/ModuleCache.hs b/hie-plugin-api/Haskell/Ide/Engine/ModuleCache.hs index e9ed7a7f5..3737419cb 100644 --- a/hie-plugin-api/Haskell/Ide/Engine/ModuleCache.hs +++ b/hie-plugin-api/Haskell/Ide/Engine/ModuleCache.hs @@ -65,8 +65,7 @@ import Haskell.Ide.Engine.MonadFunctions modifyCache :: (HasGhcModuleCache m) => (GhcModuleCache -> GhcModuleCache) -> m () modifyCache f = do - mc <- getModuleCache - setModuleCache (f mc) + modifyModuleCache (f mc) -- --------------------------------------------------------------------- -- | Run the given action in context and initialise a session with hie-bios. @@ -411,7 +410,9 @@ failModule fp = do runDeferredActions :: FilePath -> UriCacheResult -> IdeGhcM () runDeferredActions uri res = do - actions <- fmap (fromMaybe [] . Map.lookup uri) (requestQueue <$> readMTS) + -- In general it is unsafe to read and then modify but the modification doesn't + -- capture the previously read state. + actions <- fromMaybe [] . Map.lookup uri . requestQueue <$> readMTS -- remove queued actions modifyMTS $ \s -> s { requestQueue = Map.delete uri (requestQueue s) } diff --git a/hie-plugin-api/Haskell/Ide/Engine/PluginsIdeMonads.hs b/hie-plugin-api/Haskell/Ide/Engine/PluginsIdeMonads.hs index 883129144..09ab39a95 100644 --- a/hie-plugin-api/Haskell/Ide/Engine/PluginsIdeMonads.hs +++ b/hie-plugin-api/Haskell/Ide/Engine/PluginsIdeMonads.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE BangPatterns #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE DeriveAnyClass #-} @@ -10,7 +9,6 @@ {-# LANGUAGE RankNTypes #-} {-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE StandaloneDeriving #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE LambdaCase #-} @@ -359,8 +357,7 @@ type IdeGhcM = GhcT IdeM runIdeGhcM :: IdePlugins -> Maybe (Core.LspFuncs Config) -> TVar IdeState -> IdeGhcM a -> IO a runIdeGhcM plugins mlf stateVar f = do env <- IdeEnv <$> pure mlf <*> getProcessID <*> pure plugins - eres <- flip runReaderT stateVar $ flip runReaderT env $ BIOS.withGhcT f - return eres + flip runReaderT stateVar $ flip runReaderT env $ BIOS.withGhcT f {- -- | Run an IdeGhcM in an external context (e.g. HaRe), with no plugins or LSP functions @@ -571,20 +568,20 @@ instance LiftsToGhc IdeGhcM where instance HasGhcModuleCache IdeGhcM where getModuleCache = lift getModuleCache - setModuleCache = lift . setModuleCache + modifyModuleCache = lift . modifyModuleCache instance HasGhcModuleCache IdeDeferM where getModuleCache = lift getModuleCache - setModuleCache = lift . setModuleCache + modifyModuleCache = lift . modifyModuleCache instance HasGhcModuleCache IdeM where getModuleCache = do tvar <- lift ask state <- readTVarIO tvar return (moduleCache state) - setModuleCache !mc = do + modifyModuleCache f = do tvar <- lift ask - atomically $ modifyTVar' tvar (\st -> st { moduleCache = mc }) + atomically $ modifyTVar' tvar (\st -> st { moduleCache = f (moduleCache st) }) -- --------------------------------------------------------------------- From 523da4d9514cea0385c4dfb04e15eca1e5aa5dda Mon Sep 17 00:00:00 2001 From: Matthew Pickering Date: Fri, 8 Nov 2019 22:02:10 +0000 Subject: [PATCH 25/67] Revert "Revert "Track changes to haskell-lsp"" This reverts commit 9fc2dcc3746c4dcc60b2dc9ab4922e66daa6be4e. --- hie-plugin-api/Haskell/Ide/Engine/PluginUtils.hs | 2 +- src/Haskell/Ide/Engine/Transport/LspStdio.hs | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/hie-plugin-api/Haskell/Ide/Engine/PluginUtils.hs b/hie-plugin-api/Haskell/Ide/Engine/PluginUtils.hs index 501d04c5c..42282b911 100644 --- a/hie-plugin-api/Haskell/Ide/Engine/PluginUtils.hs +++ b/hie-plugin-api/Haskell/Ide/Engine/PluginUtils.hs @@ -279,7 +279,7 @@ readVFS :: (MonadIde m, MonadIO m) => Uri -> m (Maybe T.Text) readVFS uri = do mvf <- getVirtualFile uri case mvf of - Just (VirtualFile _ txt _) -> return $ Just (Rope.toText txt) + Just (VirtualFile _ txt) -> return $ Just (Rope.toText txt) Nothing -> return Nothing getRangeFromVFS :: (MonadIde m, MonadIO m) => Uri -> Range -> m (Maybe T.Text) diff --git a/src/Haskell/Ide/Engine/Transport/LspStdio.hs b/src/Haskell/Ide/Engine/Transport/LspStdio.hs index 95ce38bc1..ffe3b5faf 100644 --- a/src/Haskell/Ide/Engine/Transport/LspStdio.hs +++ b/src/Haskell/Ide/Engine/Transport/LspStdio.hs @@ -783,7 +783,7 @@ withDocumentContents reqId uri f = do (J.responseId reqId) J.InvalidRequest "Document was not open" - Just (VFS.VirtualFile _ txt _) -> f (Rope.toText txt) + Just (VFS.VirtualFile _ txt) -> f (Rope.toText txt) -- | Get the currently configured formatter provider. -- The currently configured formatter provider is defined in @Config@ by PluginId. From dc8dab183dee84b7333695b552272c86107e4798 Mon Sep 17 00:00:00 2001 From: Matthew Pickering Date: Fri, 8 Nov 2019 22:07:12 +0000 Subject: [PATCH 26/67] Fix module cache --- hie-plugin-api/Haskell/Ide/Engine/ModuleCache.hs | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/hie-plugin-api/Haskell/Ide/Engine/ModuleCache.hs b/hie-plugin-api/Haskell/Ide/Engine/ModuleCache.hs index 3737419cb..347b24e1a 100644 --- a/hie-plugin-api/Haskell/Ide/Engine/ModuleCache.hs +++ b/hie-plugin-api/Haskell/Ide/Engine/ModuleCache.hs @@ -64,8 +64,7 @@ import Haskell.Ide.Engine.MonadFunctions -- --------------------------------------------------------------------- modifyCache :: (HasGhcModuleCache m) => (GhcModuleCache -> GhcModuleCache) -> m () -modifyCache f = do - modifyModuleCache (f mc) +modifyCache f = modifyModuleCache f -- --------------------------------------------------------------------- -- | Run the given action in context and initialise a session with hie-bios. From d646605fb3e2de7960265d56257ab8b9e57706b7 Mon Sep 17 00:00:00 2001 From: Alan Zimmerman Date: Sat, 9 Nov 2019 14:58:50 +0000 Subject: [PATCH 27/67] Make sure test dispatcher runs in a clean environment --- test/dispatcher/Main.hs | 18 +++++++++++++----- 1 file changed, 13 insertions(+), 5 deletions(-) diff --git a/test/dispatcher/Main.hs b/test/dispatcher/Main.hs index 0fe09ff73..0388f264a 100644 --- a/test/dispatcher/Main.hs +++ b/test/dispatcher/Main.hs @@ -21,6 +21,7 @@ import Haskell.Ide.Engine.Types import Language.Haskell.LSP.Types import TestUtils import System.Directory +import System.Environment import System.FilePath import Test.Hspec @@ -71,12 +72,19 @@ startServer :: IO (Scheduler IO, TChan LogVal, ThreadId) startServer = do scheduler <- newScheduler plugins testOptions logChan <- newTChanIO - dispatcher <- forkIO $ + dispatcher <- forkIO $ do + -- We need to clear these environment variables to prevent + -- collisions with stack usages + -- See https://github.com/commercialhaskell/stack/issues/4875 + unsetEnv "GHC_PACKAGE_PATH" + unsetEnv "GHC_ENVIRONMENT" + unsetEnv "HASKELL_PACKAGE_SANDBOX" + unsetEnv "HASKELL_PACKAGE_SANDBOXES" runScheduler - scheduler - (\lid errCode e -> logToChan logChan ("received an error", Left (lid, errCode, e))) - (\g x -> g x) - def + scheduler + (\lid errCode e -> logToChan logChan ("received an error", Left (lid, errCode, e))) + (\g x -> g x) + def return (scheduler, logChan, dispatcher) From acf6c963397996480fcfc0d2032ac586e4ac2a1a Mon Sep 17 00:00:00 2001 From: Alan Zimmerman Date: Sat, 9 Nov 2019 15:14:57 +0000 Subject: [PATCH 28/67] Generalise flushing stack environment for tests --- test/dispatcher/Main.hs | 9 +-------- test/utils/TestUtils.hs | 13 +++++++++++++ 2 files changed, 14 insertions(+), 8 deletions(-) diff --git a/test/dispatcher/Main.hs b/test/dispatcher/Main.hs index 0388f264a..7be2f1707 100644 --- a/test/dispatcher/Main.hs +++ b/test/dispatcher/Main.hs @@ -21,7 +21,6 @@ import Haskell.Ide.Engine.Types import Language.Haskell.LSP.Types import TestUtils import System.Directory -import System.Environment import System.FilePath import Test.Hspec @@ -73,13 +72,7 @@ startServer = do scheduler <- newScheduler plugins testOptions logChan <- newTChanIO dispatcher <- forkIO $ do - -- We need to clear these environment variables to prevent - -- collisions with stack usages - -- See https://github.com/commercialhaskell/stack/issues/4875 - unsetEnv "GHC_PACKAGE_PATH" - unsetEnv "GHC_ENVIRONMENT" - unsetEnv "HASKELL_PACKAGE_SANDBOX" - unsetEnv "HASKELL_PACKAGE_SANDBOXES" + flushStackEnvironment runScheduler scheduler (\lid errCode e -> logToChan logChan ("received an error", Left (lid, errCode, e))) diff --git a/test/utils/TestUtils.hs b/test/utils/TestUtils.hs index 233b2e977..9ae27a06d 100644 --- a/test/utils/TestUtils.hs +++ b/test/utils/TestUtils.hs @@ -15,6 +15,7 @@ module TestUtils , hieCommandVomit , hieCommandExamplePlugin , getHspecFormattedConfig + , flushStackEnvironment ) where import Control.Concurrent.STM @@ -54,6 +55,7 @@ testOptions = defaultOptions { testCommand :: (ToJSON a, Typeable b, ToJSON b, Show b, Eq b) => IdePlugins -> IdeGhcM (IdeResult b) -> PluginId -> CommandName -> a -> IdeResult b -> IO () testCommand testPlugins act plugin cmd arg res = do + flushStackEnvironment (newApiRes, oldApiRes) <- runIGM testPlugins $ do new <- act old <- makeRequest plugin cmd arg @@ -285,3 +287,14 @@ xmlFormatter = silent { -- --------------------------------------------------------------------- +flushStackEnvironment :: IO () +flushStackEnvironment = do + -- We need to clear these environment variables to prevent + -- collisions with stack usages + -- See https://github.com/commercialhaskell/stack/issues/4875 + unsetEnv "GHC_PACKAGE_PATH" + unsetEnv "GHC_ENVIRONMENT" + unsetEnv "HASKELL_PACKAGE_SANDBOX" + unsetEnv "HASKELL_PACKAGE_SANDBOXES" + +-- --------------------------------------------------------------------- From bfb16324d396da71000ef81d51acbebbdaa854ab Mon Sep 17 00:00:00 2001 From: Alan Zimmerman Date: Sat, 9 Nov 2019 18:15:24 +0000 Subject: [PATCH 29/67] Call flushStackEnvironment before starting a lsp-test session --- test/functional/FunctionalCodeActionsSpec.hs | 40 ++++++++++---------- 1 file changed, 21 insertions(+), 19 deletions(-) diff --git a/test/functional/FunctionalCodeActionsSpec.hs b/test/functional/FunctionalCodeActionsSpec.hs index bfcb9e37a..80fb2310f 100644 --- a/test/functional/FunctionalCodeActionsSpec.hs +++ b/test/functional/FunctionalCodeActionsSpec.hs @@ -212,31 +212,33 @@ spec = describe "code actions" $ do ] ] describe "add package suggestions" $ do - it "adds to .cabal files" $ runSession hieCommand fullCaps "test/testdata/addPackageTest/cabal-exe" $ do - doc <- openDoc "AddPackage.hs" "haskell" + it "adds to .cabal files" $ do + flushStackEnvironment + runSession hieCommand fullCaps "test/testdata/addPackageTest/cabal-exe" $ do + doc <- openDoc "AddPackage.hs" "haskell" - -- ignore the first empty hlint diagnostic publish - [_,diag:_] <- count 2 waitForDiagnostics + -- ignore the first empty hlint diagnostic publish + [_,diag:_] <- count 2 waitForDiagnostics - let prefixes = [ "Could not load module `Data.Text'" -- Windows && GHC >= 8.6 - , "Could not find module `Data.Text'" -- Windows - , "Could not load module ‘Data.Text’" -- GHC >= 8.6 - , "Could not find module ‘Data.Text’" - ] - in liftIO $ diag ^. L.message `shouldSatisfy` \m -> any (`T.isPrefixOf` m) prefixes + let prefixes = [ "Could not load module `Data.Text'" -- Windows && GHC >= 8.6 + , "Could not find module `Data.Text'" -- Windows + , "Could not load module ‘Data.Text’" -- GHC >= 8.6 + , "Could not find module ‘Data.Text’" + ] + in liftIO $ diag ^. L.message `shouldSatisfy` \m -> any (`T.isPrefixOf` m) prefixes - acts <- getAllCodeActions doc - let (CACodeAction action:_) = acts + acts <- getAllCodeActions doc + let (CACodeAction action:_) = acts - liftIO $ do - action ^. L.title `shouldBe` "Add text as a dependency" - action ^. L.kind `shouldBe` Just CodeActionQuickFix - action ^. L.command . _Just . L.command `shouldSatisfy` T.isSuffixOf "package:add" + liftIO $ do + action ^. L.title `shouldBe` "Add text as a dependency" + action ^. L.kind `shouldBe` Just CodeActionQuickFix + action ^. L.command . _Just . L.command `shouldSatisfy` T.isSuffixOf "package:add" - executeCodeAction action + executeCodeAction action - contents <- getDocumentEdit . TextDocumentIdentifier =<< getDocUri "add-package-test.cabal" - liftIO $ T.lines contents `shouldSatisfy` \x -> any (\l -> "text -any" `T.isSuffixOf` (x !! l)) [15, 16] + contents <- getDocumentEdit . TextDocumentIdentifier =<< getDocUri "add-package-test.cabal" + liftIO $ T.lines contents `shouldSatisfy` \x -> any (\l -> "text -any" `T.isSuffixOf` (x !! l)) [15, 16] it "adds to hpack package.yaml files" $ runSession hieCommand fullCaps "test/testdata/addPackageTest/hpack-exe" $ do From 0e6742d2049eb8bbfcb79b4c057a598b373f82da Mon Sep 17 00:00:00 2001 From: Alan Zimmerman Date: Sat, 9 Nov 2019 19:28:41 +0000 Subject: [PATCH 30/67] Disbale some logging --- src/Haskell/Ide/Engine/Plugin/Liquid.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Haskell/Ide/Engine/Plugin/Liquid.hs b/src/Haskell/Ide/Engine/Plugin/Liquid.hs index b00c1086f..4868a7704 100644 --- a/src/Haskell/Ide/Engine/Plugin/Liquid.hs +++ b/src/Haskell/Ide/Engine/Plugin/Liquid.hs @@ -164,7 +164,7 @@ runLiquidHaskell fp = do let cmd = lh ++ " --json \"" ++ fp ++ "\"" dir = takeDirectory fp cp = (shell cmd) { cwd = Just dir } - logm $ "runLiquidHaskell:cmd=[" ++ cmd ++ "]" + -- logm $ "runLiquidHaskell:cmd=[" ++ cmd ++ "]" mpp <- lookupEnv "GHC_PACKAGE_PATH" mge <- lookupEnv "GHC_ENVIRONMENT" -- logm $ "runLiquidHaskell:mpp=[" ++ show mpp ++ "]" From 865ef78bbe15be38c72d198e16dc259231d6df48 Mon Sep 17 00:00:00 2001 From: jneira Date: Mon, 11 Nov 2019 13:48:00 +0100 Subject: [PATCH 31/67] Add process dep to unit-test --- haskell-ide-engine.cabal | 1 + 1 file changed, 1 insertion(+) diff --git a/haskell-ide-engine.cabal b/haskell-ide-engine.cabal index f55d52f4b..8465147eb 100644 --- a/haskell-ide-engine.cabal +++ b/haskell-ide-engine.cabal @@ -201,6 +201,7 @@ test-suite unit-test , hie-plugin-api , hoogle > 5.0.11 , hspec + , process , quickcheck-instances , text , unordered-containers From 8d1e590de6a85b96b5fbbcafd3ded55bfdef1b16 Mon Sep 17 00:00:00 2001 From: jneira Date: Mon, 11 Nov 2019 13:49:57 +0100 Subject: [PATCH 32/67] Unit test over the liquid haskell supported version --- test/unit/LiquidSpec.hs | 10 ++++++++-- 1 file changed, 8 insertions(+), 2 deletions(-) diff --git a/test/unit/LiquidSpec.hs b/test/unit/LiquidSpec.hs index cc8f0095d..16191fb6a 100644 --- a/test/unit/LiquidSpec.hs +++ b/test/unit/LiquidSpec.hs @@ -8,12 +8,12 @@ import qualified Data.ByteString.Lazy as BS import qualified Data.Text as T import qualified Data.Text.IO as T import Data.Monoid ((<>)) -import Data.Maybe (isJust) import Haskell.Ide.Engine.MonadTypes import Haskell.Ide.Engine.Plugin.Liquid import System.Directory import System.Exit import System.FilePath +import System.Process import Test.Hspec -- import Control.Monad.IO.Class @@ -27,7 +27,13 @@ spec = do -- --------------------------------- - it "finds liquid haskell exe in $PATH" $ findExecutable "liquid" >>= (`shouldSatisfy` isJust) + it "the liquid haskell exe in $PATH has the supported version" $ do + mexe <- findExecutable "liquid" + case mexe of + Nothing -> expectationFailure "liquid haskell exe is NOT in $PATH" + Just exe -> do + version <- readProcess exe ["--numeric-version"] "" + version `shouldSatisfy` isPrefixOf "0.8.6.2" -- --------------------------------- From 6a8f89cdb8757b045b91b36699e91dd6eae0ca18 Mon Sep 17 00:00:00 2001 From: jneira Date: Tue, 12 Nov 2019 14:51:30 +0100 Subject: [PATCH 33/67] Use explicit list of ghc supported versions --- install/src/Env.hs | 15 ++++++++++++--- 1 file changed, 12 insertions(+), 3 deletions(-) diff --git a/install/src/Env.hs b/install/src/Env.hs index b7d232c37..bdc69b858 100644 --- a/install/src/Env.hs +++ b/install/src/Env.hs @@ -40,6 +40,15 @@ existsExecutable executable = liftIO $ isJust <$> findExecutable executable isWindowsSystem :: Bool isWindowsSystem = os `elem` ["mingw32", "win32"] +-- | Defines all different hie versions that are supported. +-- On windows, `8.6.3` is excluded as this version of ghc does not work there +supportedGhcVersions :: [VersionNumber] +supportedGhcVersions = sort (commonVersions ++ osVersions) + where commonVersions = ["8.4.2", "8.4.3", "8.4.4", "8.6.1", "8.6.2", "8.6.4", "8.6.5"] + -- the following lines exclude `8.6.3` on windows systems + osVersions | isWindowsSystem = [] + | otherwise = ["8.6.3"] + findInstalledGhcs :: IO [(VersionNumber, GhcPath)] findInstalledGhcs = do hieVersions <- getHieVersions :: IO [VersionNumber] @@ -49,7 +58,8 @@ findInstalledGhcs = do Just p -> return $ Just (version, p) ) (reverse hieVersions) - availableGhcs <- getGhcPaths + -- filter out not supported ghc versions + availableGhcs <- filter ((`elem` supportedGhcVersions) . fst) <$> getGhcPaths return -- nub by version. knownGhcs takes precedence. $ nubBy ((==) `on` fst) @@ -99,8 +109,7 @@ getHieVersions = do & mapMaybe (T.stripPrefix stackYamlPrefix >=> T.stripSuffix stackYamlSuffix) & map T.unpack - -- the following line excludes `8.6.3` on windows systems - & filter (\p -> not isWindowsSystem || p /= "8.6.3") + & filter (\p -> p `elem` supportedGhcVersions) & sort return hieVersions From 78fdd5ba983296e898ce6ee5c43da92302c7c8fa Mon Sep 17 00:00:00 2001 From: jneira Date: Tue, 12 Nov 2019 14:52:34 +0100 Subject: [PATCH 34/67] Add lastest, change default to it add warn about build-all --- install/src/Help.hs | 40 ++++++++++++++++++++++++++++++++------- install/src/HieInstall.hs | 19 +++++++++++++++---- install/src/Print.hs | 2 +- 3 files changed, 49 insertions(+), 12 deletions(-) diff --git a/install/src/Help.hs b/install/src/Help.hs index 7a8b347e6..3328cf3e1 100644 --- a/install/src/Help.hs +++ b/install/src/Help.hs @@ -12,13 +12,23 @@ import Version import BuildSystem import Cabal +stackCommand :: String -> String +stackCommand target = "stack install.hs " ++ target + +cabalCommand :: String -> String +cabalCommand target = "cabal new-run install.hs --project-file install/shake.project " ++ target + +buildCommand :: String -> String +buildCommand | isRunFromCabal = cabalCommand + | otherwise = stackCommand + printUsage :: Action () printUsage = do printLine "" printLine "Usage:" - printLineIndented "stack install.hs " + printLineIndented (stackCommand "") printLineIndented "or" - printLineIndented "cabal new-run install.hs --project-file install/shake.project " + printLineIndented (cabalCommand "") -- | short help message is printed by default shortHelpMessage :: Action () @@ -76,7 +86,7 @@ helpMessage versions@BuildableVersions {..} = do -- All targets with their respective help message. generalTargets = [helpTarget] - defaultTargets = [buildTarget, buildAllTarget, buildDataTarget] + defaultTargets = [buildTarget, buildLastestTarget, buildAllTarget, buildDataTarget] ++ map hieTarget (getDefaultBuildSystemVersions versions) stackTargets = @@ -114,7 +124,10 @@ hieTarget version = ("hie-" ++ version, "Builds hie for GHC version " ++ version) buildTarget :: TargetDescription -buildTarget = ("build", "Builds hie with all installed GHCs") +buildTarget = ("build", "Build hie with the lastest available GHC and the data files") + +buildLastestTarget :: TargetDescription +buildLastestTarget = ("build-lastest", "Build hie with the lastest available GHC") buildDataTarget :: TargetDescription buildDataTarget = @@ -122,9 +135,20 @@ buildDataTarget = buildAllTarget :: TargetDescription buildAllTarget = - ("build-all", "Builds hie for all installed GHC versions and the data files") + ( "build-all" + , "Builds hie for all installed GHC versions and the data files. " + ++ buildAllWarning) + +buildAllWarning :: String +buildAllWarning = "WARNING: This command may take a long time and computer resources" + +buildAllWarningAlt :: String +buildAllWarningAlt = "Consider build only the needed ghc versions using:\n" + ++ " " ++ buildCommand "build-${ghcVersion}\n" + ++ "or the lastest available one with:\n" + ++ " " ++ buildCommand "build-lastest\n" --- speical targets +-- special targets macosIcuTarget :: TargetDescription macosIcuTarget = ("icu-macos-fix", "Fixes icu related problems in MacOS") @@ -141,7 +165,9 @@ cabalGhcsTarget = installCabalTarget :: TargetDescription installCabalTarget = ( "install-cabal" - , "Install the cabal executable. It will install the required minimum version for hie (currently " ++ versionToString requiredCabalVersion ++ ") if it isn't already present in $PATH" + , "Install the cabal executable. It will install the required minimum version for hie (currently " + ++ versionToString requiredCabalVersion + ++ ") if it isn't already present in $PATH" ) -- | Creates a message of the form "a, b, c and d", where a,b,c,d are GHC versions. diff --git a/install/src/HieInstall.hs b/install/src/HieInstall.hs index b05f1714d..0928aa989 100644 --- a/install/src/HieInstall.hs +++ b/install/src/HieInstall.hs @@ -57,6 +57,8 @@ defaultMain = do , cabalVersions = ghcVersions } + let lastestVersion = last hieVersions + putStrLn $ "run from: " ++ buildSystem shakeArgs shakeOptions { shakeFiles = "_build" } $ do @@ -82,6 +84,7 @@ defaultMain = do -- default-targets phony "build" $ need [buildSystem ++ "-build"] + phony "build-lastest" $ need [buildSystem ++ "-build-lastest"] phony "build-all" $ need [buildSystem ++ "-build-all"] phony "build-data" $ need [buildSystem ++ "-build-data"] forM_ @@ -92,8 +95,12 @@ defaultMain = do -- stack specific targets when isRunFromStack (phony "stack-install-cabal" (need ["cabal"])) - phony "stack-build" (need (reverse $ map ("stack-hie-" ++) hieVersions)) - phony "stack-build-all" (need ["build-data", "build"]) + phony "stack-build-lastest" (need ["stack-hie-" ++ last hieVersions]) + phony "stack-build" (need ["build-data", "stack-build-lastest"]) + phony "stack-build-all" $ do + printInStars (buildAllWarning ++ ".\n" ++ buildAllWarningAlt) + need (["build-data"] ++ (reverse $ map ("stack-hie-" ++) hieVersions)) + phony "stack-build-data" $ do need ["submodules"] need ["check-stack"] @@ -108,8 +115,12 @@ defaultMain = do ) -- cabal specific targets - phony "cabal-build" (need (map ("cabal-hie-" ++) ghcVersions)) - phony "cabal-build-all" (need ["cabal-build-data", "cabal-build"]) + phony "cabal-build-lastest" (need ["cabal-hie-" ++ last ghcVersions]) + phony "cabal-build" (need ["build-data", "cabal-build-lastest"]) + phony "cabal-build-all" $ do + printInStars (buildAllWarning ++ ".\n" ++ buildAllWarningAlt) + need (["cabal-build-data"] ++ (map ("cabal-hie-" ++) ghcVersions)) + phony "cabal-build-data" $ do need ["submodules"] need ["cabal"] diff --git a/install/src/Print.hs b/install/src/Print.hs index 82904491f..41216022b 100644 --- a/install/src/Print.hs +++ b/install/src/Print.hs @@ -18,7 +18,7 @@ printLineIndented = printLine . (" " ++) embedInStars :: String -> String embedInStars str = - let starsLine = "\n" <> replicate 30 '*' <> "\n" + let starsLine = "\n" <> replicate 80 '*' <> "\n" in starsLine <> str <> starsLine printInStars :: MonadIO m => String -> m () From 0e2646bfb81c5ebd7103e503eb38120b90bc2407 Mon Sep 17 00:00:00 2001 From: jneira Date: Wed, 13 Nov 2019 08:27:25 +0100 Subject: [PATCH 35/67] Fix getGhcPathOf for windows --- install/src/Env.hs | 11 ++++++----- 1 file changed, 6 insertions(+), 5 deletions(-) diff --git a/install/src/Env.hs b/install/src/Env.hs index bdc69b858..642a8ab47 100644 --- a/install/src/Env.hs +++ b/install/src/Env.hs @@ -54,8 +54,8 @@ findInstalledGhcs = do hieVersions <- getHieVersions :: IO [VersionNumber] knownGhcs <- mapMaybeM (\version -> getGhcPathOf version >>= \case - Nothing -> return Nothing - Just p -> return $ Just (version, p) + Nothing -> return Nothing + Just p -> return $ Just (version, p) ) (reverse hieVersions) -- filter out not supported ghc versions @@ -63,7 +63,7 @@ findInstalledGhcs = do return -- nub by version. knownGhcs takes precedence. $ nubBy ((==) `on` fst) - -- filter out stack provided GHCs + -- filter out stack provided GHCs (assuming that stack programs path is the default one in linux) $ filter (not . isInfixOf ".stack" . snd) (knownGhcs ++ availableGhcs) -- | Get the path to a GHC that has the version specified by `VersionNumber` @@ -73,9 +73,11 @@ findInstalledGhcs = do -- command fits to the desired version. getGhcPathOf :: MonadIO m => VersionNumber -> m (Maybe GhcPath) getGhcPathOf ghcVersion = - liftIO $ findExecutable ("ghc-" ++ ghcVersion) >>= \case + liftIO $ findExecutable ("ghc-" ++ ghcVersion <.> exe) >>= \case Nothing -> lookup ghcVersion <$> getGhcPaths path -> return path + where exe | isWindowsSystem = "exe" + | otherwise = "" -- | Get a list of GHCs that are available in $PATH getGhcPaths :: MonadIO m => m [(VersionNumber, GhcPath)] @@ -97,7 +99,6 @@ ghcVersionNotFoundFailMsg versionNumber = -- | Defines all different hie versions that are buildable. -- -- The current directory is scanned for `stack-*.yaml` files. --- On windows, `8.6.3` is excluded as this version of ghc does not work there getHieVersions :: MonadIO m => m [VersionNumber] getHieVersions = do let stackYamlPrefix = T.pack "stack-" From 16be8e7381302d62b6c0a2c4654b3d8993a919a6 Mon Sep 17 00:00:00 2001 From: jneira Date: Wed, 13 Nov 2019 08:38:43 +0100 Subject: [PATCH 36/67] Sort installed ghcs to fix the lastest target --- install/src/Env.hs | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/install/src/Env.hs b/install/src/Env.hs index 642a8ab47..45e9ebc01 100644 --- a/install/src/Env.hs +++ b/install/src/Env.hs @@ -17,9 +17,11 @@ import Data.Function ( (&) , on ) import Data.List ( sort + , sortBy , isInfixOf , nubBy ) +import Data.Ord ( comparing ) import Control.Monad.Extra ( mapMaybeM ) import Data.Maybe ( isNothing , mapMaybe @@ -61,6 +63,8 @@ findInstalledGhcs = do -- filter out not supported ghc versions availableGhcs <- filter ((`elem` supportedGhcVersions) . fst) <$> getGhcPaths return + -- sort by version to make it coherent with getHieVersions + $ sortBy (comparing fst) -- nub by version. knownGhcs takes precedence. $ nubBy ((==) `on` fst) -- filter out stack provided GHCs (assuming that stack programs path is the default one in linux) From bb61dd1e9e4fef0a304831e0c76ff68afb793ae2 Mon Sep 17 00:00:00 2001 From: jneira Date: Wed, 13 Nov 2019 13:48:45 +0100 Subject: [PATCH 37/67] Fix error in splitPaths --- install/src/Stack.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/install/src/Stack.hs b/install/src/Stack.hs index 210d406e9..b9cf2afd4 100644 --- a/install/src/Stack.hs +++ b/install/src/Stack.hs @@ -135,5 +135,5 @@ withoutStackCachedBinaries action = do splitPaths s = case dropWhile (== searchPathSeparator) s of "" -> [] - s' -> w : words s'' + s' -> w : splitPaths s'' where (w, s'') = break (== searchPathSeparator) s' From 9e70be83460057e53cf9d2f03393cf7ffb7d6aca Mon Sep 17 00:00:00 2001 From: jneira Date: Wed, 13 Nov 2019 14:57:37 +0100 Subject: [PATCH 38/67] Fix ghc version used to install hie --- install/src/Cabal.hs | 12 +++++++++--- 1 file changed, 9 insertions(+), 3 deletions(-) diff --git a/install/src/Cabal.hs b/install/src/Cabal.hs index 0c0ca380d..32c9c0f40 100644 --- a/install/src/Cabal.hs +++ b/install/src/Cabal.hs @@ -31,13 +31,17 @@ cabalBuildData = do execCabal_ ["v2-build", "hoogle"] execCabal_ ["v2-exec", "hoogle", "generate"] -cabalBuildHie :: VersionNumber -> Action () -cabalBuildHie versionNumber = do - ghcPath <- getGhcPathOf versionNumber >>= \case +getGhcPathOfOrThrowError :: VersionNumber -> Action GhcPath +getGhcPathOfOrThrowError versionNumber = + getGhcPathOf versionNumber >>= \case Nothing -> do printInStars $ ghcVersionNotFoundFailMsg versionNumber error (ghcVersionNotFoundFailMsg versionNumber) Just p -> return p + +cabalBuildHie :: VersionNumber -> Action () +cabalBuildHie versionNumber = do + ghcPath <- getGhcPathOfOrThrowError versionNumber execCabal_ ["v2-build", "-w", ghcPath, "--write-ghc-environment-files=never", "--max-backjumps=5000", "--disable-tests"] @@ -45,6 +49,7 @@ cabalInstallHie :: VersionNumber -> Action () cabalInstallHie versionNumber = do localBin <- getLocalBin cabalVersion <- getCabalVersion + ghcPath <- getGhcPathOfOrThrowError versionNumber let isCabal3 = checkVersion [3,0,0,0] cabalVersion installDirOpt | isCabal3 = "--installdir" @@ -53,6 +58,7 @@ cabalInstallHie versionNumber = do | otherwise = [] execCabal_ $ [ "v2-install" + , "-w", ghcPath , "--write-ghc-environment-files=never" , installDirOpt ++ "=" ++ localBin , "exe:hie" From 36fa8152946cc91e92afda3d0e4cac7bc0291708 Mon Sep 17 00:00:00 2001 From: jneira Date: Wed, 13 Nov 2019 23:03:16 +0100 Subject: [PATCH 39/67] Formatting options list of cabal build --- install/src/Cabal.hs | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/install/src/Cabal.hs b/install/src/Cabal.hs index 0c0ca380d..e0553a349 100644 --- a/install/src/Cabal.hs +++ b/install/src/Cabal.hs @@ -39,7 +39,11 @@ cabalBuildHie versionNumber = do error (ghcVersionNotFoundFailMsg versionNumber) Just p -> return p execCabal_ - ["v2-build", "-w", ghcPath, "--write-ghc-environment-files=never", "--max-backjumps=5000", "--disable-tests"] + [ "v2-build" + , "-w", ghcPath + , "--write-ghc-environment-files=never" + , "--max-backjumps=5000" + , "--disable-tests"] cabalInstallHie :: VersionNumber -> Action () cabalInstallHie versionNumber = do From 6e0cf21379cd858af01036c0c9bb8f8d1e33a794 Mon Sep 17 00:00:00 2001 From: jneira Date: Thu, 14 Nov 2019 07:35:29 +0100 Subject: [PATCH 40/67] Use cabal options consistently --- install/src/Cabal.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/install/src/Cabal.hs b/install/src/Cabal.hs index dca7cdfc7..25d1c0203 100644 --- a/install/src/Cabal.hs +++ b/install/src/Cabal.hs @@ -64,7 +64,7 @@ cabalInstallHie versionNumber = do [ "v2-install" , "-w", ghcPath , "--write-ghc-environment-files=never" - , installDirOpt ++ "=" ++ localBin + , installDirOpt, localBin , "exe:hie" , "--overwrite-policy=always" ] From bf7d4b4915656fbb2b2333d823dac572f2c0d636 Mon Sep 17 00:00:00 2001 From: jneira Date: Thu, 14 Nov 2019 08:06:18 +0100 Subject: [PATCH 41/67] Update documentation about build system --- README.md | 3 +-- docs/Build.md | 21 ++++++++++----------- 2 files changed, 11 insertions(+), 13 deletions(-) diff --git a/README.md b/README.md index 0a1d4aba7..667ef1105 100644 --- a/README.md +++ b/README.md @@ -214,7 +214,7 @@ cabal v2-run ./install.hs --project-file install/shake.project Running the script with cabal on windows requires a cabal version greater or equal to `3.0.0.0`. -Unfortunately, it is still required to have `stack` installed so that the install-script can locate the `local-bin` directory (on Linux `~/.local/bin`) and copy the `hie` binaries to `hie-x.y.z`, which is required for the `hie-wrapper` to function as expected. +Unfortunately, it is still required to have `stack` installed so that the install-script can locate the `local-bin` directory (on Linux `~/.local/bin`) and copy the `hie` binaries to `hie-x.y.z`, which is required for the `hie-wrapper` to function as expected. There are plans to remove this requirement and let users build hie only with one build tool or another. For brevity, only the `stack`-based commands are presented in the following sections. @@ -246,7 +246,6 @@ stack ./install.hs build-data The Haskell IDE Engine can also be built with `cabal new-build` instead of `stack build`. This has the advantage that you can decide how the GHC versions have been installed. -However, this approach does currently not work for windows due to a missing feature upstream. To see what GHC versions are available, the command `stack install.hs cabal-ghcs` can be used. It will list all GHC versions that are on the path and their respective installation directory. If you think, this list is incomplete, you can try to modify the PATH variable, such that the executables can be found. diff --git a/docs/Build.md b/docs/Build.md index 83c6afcbc..27fa4ad36 100644 --- a/docs/Build.md +++ b/docs/Build.md @@ -28,8 +28,10 @@ See the project's `README` for detailed information about installing `hie`. The build script `install.hs` defines several targets using the `shake` build system. The targets are roughly: * `hie-*`: builds and installs the `hie` binaries. Also renames the binaries to contain the correct version-number. -* `build`: builds and installs `hie` binaries for all supported `ghc` versions. +* `build-lastest`: builds ad installs `hie` for the last available and supported `ghc` version. +* `build-all`: builds and installs `hie` binaries for all supported `ghc` versions. This option may take a long time and computer resources so use it with caution. * `build-data`: builds the hoogle-db required by `hie` +* `build`: builds ad installs `hie` for the last supported `ghc` version (like `build-lastest`) and the hoogle-db (like `build-data`) * `cabal-*`: execute the same task as the original target, but with `cabal` instead of `stack` Each `stack-*.yaml` contains references to packages in the submodules. Calling `stack` with one of those causes the build to fail if the submodules have not been initialized already. The file `shake.yaml` solves this issue invoking the `git` binary itself to update the submodules. Moreover, it specifies the correct version of `shake` and is used for installing all run-time dependencies such as `cabal` and `hoogle` if necessary. @@ -38,7 +40,7 @@ Each `stack-*.yaml` contains references to packages in the submodules. Calling ` `hie` depends on a correct environment in order to function properly: -* `cabal-install`: If no `cabal` executable can be found or has an outdated version, `cabal-install` is installed via `stack`. +* `cabal-install`: This dependency is required by `hie` to handle correctly projects that are not `stack` based (without `stack.yaml`). You can install an appropiate version using `stack` with the `stack-install-cabal` target. * The `hoogle` database: `hoogle generate` needs to be called with the most-recent `hoogle` version. ### Steps to build `hie` @@ -47,10 +49,9 @@ Installing `hie` is a multi-step process: 1. `git submodule sync && git submodule update --init` 2. `hoogle generate` (`hoogle>=5.0.17` to be safe) -3. ensure that `cabal-install` is installed in the correct version -4. `stack --stack-yaml=stack-.yaml install` or `cabal new-install -w ghc-` -5. rename `hie` binary to `hie-` in `$HOME/.local/bin`, where `` is the GHC version used -6. repeat step 4 and 5 for all desired GHC versions +3. `stack --stack-yaml=stack-.yaml install` or `cabal new-install -w ghc-` +4. rename `hie` binary to `hie-` in `$HOME/.local/bin`, where `` is the GHC version used +5. repeat step 4 and 5 for all desired GHC versions This ensures that a complete install is always possible after each `git pull` or a `git clone`. @@ -90,19 +91,17 @@ The final step is to configure the `hie` client to use a custom `hie-wrapper` sc The `install.hs` script performs some checks to ensure that a correct installation is possible and provide meaningful error messages for known issues. * `stack` needs to be up-to-date. Version `1.9.3` is required +* `cabal` needs to be up-to-date. Version `3.0.0.0` is required for windows systems and `2.4.1.0` for other ones. * `ghc-8.6.3` is broken on windows. Trying to install `hie-8.6.3` on windows is not possible. -* `cabal new-build` does not work on windows at the moment. All `cabal-*` targets exit with an error message about that. * When the build fails, an error message, that suggests to remove `.stack-work` directory, is displayed. ### Tradeoffs #### `stack` is a build dependency -Currently, it is not possible to build all `hie-*` executables automatically without `stack`, since the `install.hs` script is executed by `stack`. +Currently, `stack` is needed even if you run the script with `cabal` to get the path where install the binaries but there are plans to remove that dependency (see #1380). -We are open to suggestions of other build systems that honor the requirements above, but are executable without `stack`. - -#### `install.hs` installs a GHC before running +#### run `install.hs` with `stack` installs a GHC before running Before the code in `install.hs` can be executed, `stack` installs a `GHC`, depending on the `resolver` field in `shake.yaml`. This is necessary if `install.hs` should be completely functional right after a fresh `git clone` without further configuration. From 8e909e8aa4ee9ef57dc7c2535b8a44ff466e50d6 Mon Sep 17 00:00:00 2001 From: jneira Date: Thu, 14 Nov 2019 08:42:45 +0100 Subject: [PATCH 42/67] Mention cabal issue about set custom project file --- install.hs | 1 + 1 file changed, 1 insertion(+) diff --git a/install.hs b/install.hs index b68745bd3..094ee774a 100755 --- a/install.hs +++ b/install.hs @@ -14,6 +14,7 @@ build-depends: -- * `stack install.hs ` -- TODO: set `shake.project` in cabal-config above, when supported +-- (see https://github.com/haskell/cabal/issues/6353) import HieInstall (defaultMain) From 0f72de0c98021299747e59ab17358edd769493ac Mon Sep 17 00:00:00 2001 From: jneira Date: Thu, 14 Nov 2019 10:37:54 +0100 Subject: [PATCH 43/67] Use TargetDescription to print targets --- install/src/Help.hs | 21 ++++++++++++--------- 1 file changed, 12 insertions(+), 9 deletions(-) diff --git a/install/src/Help.hs b/install/src/Help.hs index 3328cf3e1..5fcae8e1e 100644 --- a/install/src/Help.hs +++ b/install/src/Help.hs @@ -12,13 +12,13 @@ import Version import BuildSystem import Cabal -stackCommand :: String -> String -stackCommand target = "stack install.hs " ++ target +stackCommand :: TargetDescription -> String +stackCommand target = "stack install.hs " ++ fst target -cabalCommand :: String -> String -cabalCommand target = "cabal new-run install.hs --project-file install/shake.project " ++ target +cabalCommand :: TargetDescription -> String +cabalCommand target = "cabal new-run install.hs --project-file install/shake.project " ++ fst target -buildCommand :: String -> String +buildCommand :: TargetDescription -> String buildCommand | isRunFromCabal = cabalCommand | otherwise = stackCommand @@ -26,9 +26,9 @@ printUsage :: Action () printUsage = do printLine "" printLine "Usage:" - printLineIndented (stackCommand "") + printLineIndented (stackCommand templateTarget) printLineIndented "or" - printLineIndented (cabalCommand "") + printLineIndented (cabalCommand templateTarget) -- | short help message is printed by default shortHelpMessage :: Action () @@ -109,6 +109,9 @@ helpMessage versions@BuildableVersions {..} = do emptyTarget :: (String, String) emptyTarget = ("", "") +templateTarget :: (String, String) +templateTarget = ("", "") + targetWithBuildSystem :: String -> TargetDescription -> TargetDescription targetWithBuildSystem system (target, description) = (system ++ "-" ++ target, description ++ "; with " ++ system) @@ -144,9 +147,9 @@ buildAllWarning = "WARNING: This command may take a long time and computer resou buildAllWarningAlt :: String buildAllWarningAlt = "Consider build only the needed ghc versions using:\n" - ++ " " ++ buildCommand "build-${ghcVersion}\n" + ++ " " ++ buildCommand (hieTarget "") ++ "\n" ++ "or the lastest available one with:\n" - ++ " " ++ buildCommand "build-lastest\n" + ++ " " ++ buildCommand (hieTarget "") ++ "\n" -- special targets From 2140a5a9ff3128b20f432088e180a54572036718 Mon Sep 17 00:00:00 2001 From: jneira Date: Thu, 14 Nov 2019 10:38:18 +0100 Subject: [PATCH 44/67] Remove unnecessary catch over lookupEnv --- install/src/Stack.hs | 5 +---- 1 file changed, 1 insertion(+), 4 deletions(-) diff --git a/install/src/Stack.hs b/install/src/Stack.hs index b9cf2afd4..96cd18334 100644 --- a/install/src/Stack.hs +++ b/install/src/Stack.hs @@ -105,10 +105,7 @@ stackBuildFailMsg = withoutStackCachedBinaries :: Action a -> Action a withoutStackCachedBinaries action = do - let getEnvErrorHandler e | isDoesNotExistError e = return Nothing - | otherwise = throwIO e - - mbPath <- liftIO (lookupEnv "PATH" `catch` getEnvErrorHandler) + mbPath <- liftIO (lookupEnv "PATH") case (mbPath, isRunFromStack) of From 15cf8ade8de693b25e628377295e35369f758b87 Mon Sep 17 00:00:00 2001 From: jneira Date: Thu, 14 Nov 2019 10:44:15 +0100 Subject: [PATCH 45/67] Run stack-install-cabal in azure ci --- .azure/linux-installhs-stack.yml | 6 +++++- .azure/macos-installhs-stack.yml | 6 +++++- .azure/windows-installhs-stack.yml | 6 +++++- 3 files changed, 15 insertions(+), 3 deletions(-) diff --git a/.azure/linux-installhs-stack.yml b/.azure/linux-installhs-stack.yml index 40bdc6424..a3c340371 100644 --- a/.azure/linux-installhs-stack.yml +++ b/.azure/linux-installhs-stack.yml @@ -29,4 +29,8 @@ jobs: - bash: | source .azure/linux.bashrc stack install.hs help - displayName: Run help of `instal.hs` + displayName: Run help of `install.hs` + - bash: | + source .azure/linux.bashrc + stack install.hs stack-install-cabal + displayName: Run stack-install-cabal target of `install.hs` diff --git a/.azure/macos-installhs-stack.yml b/.azure/macos-installhs-stack.yml index 971b12a23..1c5cc2c7b 100644 --- a/.azure/macos-installhs-stack.yml +++ b/.azure/macos-installhs-stack.yml @@ -29,4 +29,8 @@ jobs: - bash: | source .azure/macos.bashrc stack install.hs help - displayName: Run help of `instal.hs` + displayName: Run help of `install.hs` + - bash: | + source .azure/macos.bashrc + stack install.hs stack-install-cabal + displayName: Run stack-install-cabal target of `install.hs` diff --git a/.azure/windows-installhs-stack.yml b/.azure/windows-installhs-stack.yml index 3fab9d640..ccd660e3f 100644 --- a/.azure/windows-installhs-stack.yml +++ b/.azure/windows-installhs-stack.yml @@ -27,4 +27,8 @@ jobs: - bash: | source .azure/windows.bashrc stack install.hs help - displayName: Run help of `instal.hs` + displayName: Run help of `install.hs` + - bash: | + source .azure/windows.bashrc + stack install.hs stack-install-cabal + displayName: Run stack-install-cabal target of `install.hs` From 7d993196646243fb5f0ea88209469f5f41c6ed66 Mon Sep 17 00:00:00 2001 From: jneira Date: Thu, 14 Nov 2019 11:22:09 +0100 Subject: [PATCH 46/67] Change macos STACK_ROOT to avoid permission issues --- .azure/macos-stack.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.azure/macos-stack.yml b/.azure/macos-stack.yml index 42b45bb91..82178f0af 100644 --- a/.azure/macos-stack.yml +++ b/.azure/macos-stack.yml @@ -20,7 +20,7 @@ jobs: stack-8.4.2: YAML_FILE: stack-8.4.2.yaml variables: - STACK_ROOT: /Users/vsts/.stack + STACK_ROOT: $(Build.SourcesDirectory)/.stack steps: - task: CacheBeta@0 inputs: From 6f18dcae6ba5e2daf57a3a5eb359586758b1217a Mon Sep 17 00:00:00 2001 From: jneira Date: Thu, 14 Nov 2019 12:29:44 +0100 Subject: [PATCH 47/67] Correct suggestion of lastest target --- install/src/Help.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/install/src/Help.hs b/install/src/Help.hs index 5fcae8e1e..53fbc2c5d 100644 --- a/install/src/Help.hs +++ b/install/src/Help.hs @@ -149,7 +149,7 @@ buildAllWarningAlt :: String buildAllWarningAlt = "Consider build only the needed ghc versions using:\n" ++ " " ++ buildCommand (hieTarget "") ++ "\n" ++ "or the lastest available one with:\n" - ++ " " ++ buildCommand (hieTarget "") ++ "\n" + ++ " " ++ buildCommand buildLastestTarget ++ "\n" -- special targets From 1876ab5ce0f6f0216171620a6542b495a3ca8519 Mon Sep 17 00:00:00 2001 From: jneira Date: Thu, 14 Nov 2019 14:56:40 +0100 Subject: [PATCH 48/67] replace last by lastest --- docs/Build.md | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/docs/Build.md b/docs/Build.md index 27fa4ad36..db02ce6af 100644 --- a/docs/Build.md +++ b/docs/Build.md @@ -28,10 +28,10 @@ See the project's `README` for detailed information about installing `hie`. The build script `install.hs` defines several targets using the `shake` build system. The targets are roughly: * `hie-*`: builds and installs the `hie` binaries. Also renames the binaries to contain the correct version-number. -* `build-lastest`: builds ad installs `hie` for the last available and supported `ghc` version. +* `build-lastest`: builds ad installs `hie` for the lastest available and supported `ghc` version. * `build-all`: builds and installs `hie` binaries for all supported `ghc` versions. This option may take a long time and computer resources so use it with caution. * `build-data`: builds the hoogle-db required by `hie` -* `build`: builds ad installs `hie` for the last supported `ghc` version (like `build-lastest`) and the hoogle-db (like `build-data`) +* `build`: builds ad installs `hie` for the lastest supported `ghc` version (like `build-lastest`) and the hoogle-db (like `build-data`) * `cabal-*`: execute the same task as the original target, but with `cabal` instead of `stack` Each `stack-*.yaml` contains references to packages in the submodules. Calling `stack` with one of those causes the build to fail if the submodules have not been initialized already. The file `shake.yaml` solves this issue invoking the `git` binary itself to update the submodules. Moreover, it specifies the correct version of `shake` and is used for installing all run-time dependencies such as `cabal` and `hoogle` if necessary. From 2c823687797163f0b58a27b8287c98892a3df15a Mon Sep 17 00:00:00 2001 From: jneira Date: Fri, 15 Nov 2019 11:45:00 +0100 Subject: [PATCH 49/67] Replace lastest by latest --- docs/Build.md | 4 ++-- install/src/Help.hs | 14 ++++++++------ install/src/HieInstall.hs | 12 ++++++------ 3 files changed, 16 insertions(+), 14 deletions(-) diff --git a/docs/Build.md b/docs/Build.md index db02ce6af..68508d313 100644 --- a/docs/Build.md +++ b/docs/Build.md @@ -28,10 +28,10 @@ See the project's `README` for detailed information about installing `hie`. The build script `install.hs` defines several targets using the `shake` build system. The targets are roughly: * `hie-*`: builds and installs the `hie` binaries. Also renames the binaries to contain the correct version-number. -* `build-lastest`: builds ad installs `hie` for the lastest available and supported `ghc` version. +* `build-latest`: builds ad installs `hie` for the latest available and supported `ghc` version. * `build-all`: builds and installs `hie` binaries for all supported `ghc` versions. This option may take a long time and computer resources so use it with caution. * `build-data`: builds the hoogle-db required by `hie` -* `build`: builds ad installs `hie` for the lastest supported `ghc` version (like `build-lastest`) and the hoogle-db (like `build-data`) +* `build`: builds ad installs `hie` for the latest supported `ghc` version (like `build-latest`) and the hoogle-db (like `build-data`) * `cabal-*`: execute the same task as the original target, but with `cabal` instead of `stack` Each `stack-*.yaml` contains references to packages in the submodules. Calling `stack` with one of those causes the build to fail if the submodules have not been initialized already. The file `shake.yaml` solves this issue invoking the `git` binary itself to update the submodules. Moreover, it specifies the correct version of `shake` and is used for installing all run-time dependencies such as `cabal` and `hoogle` if necessary. diff --git a/install/src/Help.hs b/install/src/Help.hs index 53fbc2c5d..71629a7c4 100644 --- a/install/src/Help.hs +++ b/install/src/Help.hs @@ -86,11 +86,12 @@ helpMessage versions@BuildableVersions {..} = do -- All targets with their respective help message. generalTargets = [helpTarget] - defaultTargets = [buildTarget, buildLastestTarget, buildAllTarget, buildDataTarget] + defaultTargets = [buildTarget, buildLatestTarget, buildAllTarget, buildDataTarget] ++ map hieTarget (getDefaultBuildSystemVersions versions) stackTargets = [ stackTarget buildTarget + , stackTarget buildLatestTarget , stackTarget buildAllTarget , stackTarget buildDataTarget ] @@ -100,6 +101,7 @@ helpMessage versions@BuildableVersions {..} = do cabalTargets = [ cabalGhcsTarget , cabalTarget buildTarget + , cabalTarget buildLatestTarget , cabalTarget buildAllTarget , cabalTarget buildDataTarget ] @@ -127,10 +129,10 @@ hieTarget version = ("hie-" ++ version, "Builds hie for GHC version " ++ version) buildTarget :: TargetDescription -buildTarget = ("build", "Build hie with the lastest available GHC and the data files") +buildTarget = ("build", "Build hie with the latest available GHC and the data files") -buildLastestTarget :: TargetDescription -buildLastestTarget = ("build-lastest", "Build hie with the lastest available GHC") +buildLatestTarget :: TargetDescription +buildLatestTarget = ("build-latest", "Build hie with the latest available GHC") buildDataTarget :: TargetDescription buildDataTarget = @@ -148,8 +150,8 @@ buildAllWarning = "WARNING: This command may take a long time and computer resou buildAllWarningAlt :: String buildAllWarningAlt = "Consider build only the needed ghc versions using:\n" ++ " " ++ buildCommand (hieTarget "") ++ "\n" - ++ "or the lastest available one with:\n" - ++ " " ++ buildCommand buildLastestTarget ++ "\n" + ++ "or the latest available one with:\n" + ++ " " ++ buildCommand buildLatestTarget ++ "\n" -- special targets diff --git a/install/src/HieInstall.hs b/install/src/HieInstall.hs index 0928aa989..479e59cf9 100644 --- a/install/src/HieInstall.hs +++ b/install/src/HieInstall.hs @@ -57,7 +57,7 @@ defaultMain = do , cabalVersions = ghcVersions } - let lastestVersion = last hieVersions + let latestVersion = last hieVersions putStrLn $ "run from: " ++ buildSystem @@ -84,7 +84,7 @@ defaultMain = do -- default-targets phony "build" $ need [buildSystem ++ "-build"] - phony "build-lastest" $ need [buildSystem ++ "-build-lastest"] + phony "build-latest" $ need [buildSystem ++ "-build-latest"] phony "build-all" $ need [buildSystem ++ "-build-all"] phony "build-data" $ need [buildSystem ++ "-build-data"] forM_ @@ -95,8 +95,8 @@ defaultMain = do -- stack specific targets when isRunFromStack (phony "stack-install-cabal" (need ["cabal"])) - phony "stack-build-lastest" (need ["stack-hie-" ++ last hieVersions]) - phony "stack-build" (need ["build-data", "stack-build-lastest"]) + phony "stack-build-latest" (need ["stack-hie-" ++ last hieVersions]) + phony "stack-build" (need ["build-data", "stack-build-latest"]) phony "stack-build-all" $ do printInStars (buildAllWarning ++ ".\n" ++ buildAllWarningAlt) need (["build-data"] ++ (reverse $ map ("stack-hie-" ++) hieVersions)) @@ -115,8 +115,8 @@ defaultMain = do ) -- cabal specific targets - phony "cabal-build-lastest" (need ["cabal-hie-" ++ last ghcVersions]) - phony "cabal-build" (need ["build-data", "cabal-build-lastest"]) + phony "cabal-build-latest" (need ["cabal-hie-" ++ last ghcVersions]) + phony "cabal-build" (need ["build-data", "cabal-build-latest"]) phony "cabal-build-all" $ do printInStars (buildAllWarning ++ ".\n" ++ buildAllWarningAlt) need (["cabal-build-data"] ++ (map ("cabal-hie-" ++) ghcVersions)) From 72de08b86d018e2f63419dafb8e93a7ff06b5fe7 Mon Sep 17 00:00:00 2001 From: jneira Date: Fri, 15 Nov 2019 11:48:25 +0100 Subject: [PATCH 50/67] Use v2 prefix intead new --- install/src/Help.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/install/src/Help.hs b/install/src/Help.hs index 71629a7c4..0796b1ff8 100644 --- a/install/src/Help.hs +++ b/install/src/Help.hs @@ -16,7 +16,7 @@ stackCommand :: TargetDescription -> String stackCommand target = "stack install.hs " ++ fst target cabalCommand :: TargetDescription -> String -cabalCommand target = "cabal new-run install.hs --project-file install/shake.project " ++ fst target +cabalCommand target = "cabal v2-run install.hs --project-file install/shake.project " ++ fst target buildCommand :: TargetDescription -> String buildCommand | isRunFromCabal = cabalCommand From e27003219a78f33532cf11ae1da4e6c395f9c628 Mon Sep 17 00:00:00 2001 From: jneira Date: Fri, 15 Nov 2019 12:24:42 +0100 Subject: [PATCH 51/67] Rephrasing alternative to build-all --- install/src/Help.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/install/src/Help.hs b/install/src/Help.hs index 0796b1ff8..cb335d4db 100644 --- a/install/src/Help.hs +++ b/install/src/Help.hs @@ -148,7 +148,7 @@ buildAllWarning :: String buildAllWarning = "WARNING: This command may take a long time and computer resources" buildAllWarningAlt :: String -buildAllWarningAlt = "Consider build only the needed ghc versions using:\n" +buildAllWarningAlt = "Consider building only the ghc versions you need using:\n" ++ " " ++ buildCommand (hieTarget "") ++ "\n" ++ "or the latest available one with:\n" ++ " " ++ buildCommand buildLatestTarget ++ "\n" From 118525d44d8a2da56318647e97edc02000fb78fd Mon Sep 17 00:00:00 2001 From: jneira Date: Fri, 15 Nov 2019 12:30:52 +0100 Subject: [PATCH 52/67] Replace cabal command suffix and fix installing steps --- docs/Build.md | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/docs/Build.md b/docs/Build.md index 68508d313..222000888 100644 --- a/docs/Build.md +++ b/docs/Build.md @@ -49,15 +49,15 @@ Installing `hie` is a multi-step process: 1. `git submodule sync && git submodule update --init` 2. `hoogle generate` (`hoogle>=5.0.17` to be safe) -3. `stack --stack-yaml=stack-.yaml install` or `cabal new-install -w ghc-` +3. `stack --stack-yaml=stack-.yaml install` or `cabal v2-install -w ghc-` 4. rename `hie` binary to `hie-` in `$HOME/.local/bin`, where `` is the GHC version used -5. repeat step 4 and 5 for all desired GHC versions +5. repeat step 3 and 4 for all desired GHC versions This ensures that a complete install is always possible after each `git pull` or a `git clone`. #### Building `hie` with profiling support -To build `hie` with profiling enabled `cabal new-install` needs to be used instead of `stack`. +To build `hie` with profiling enabled `cabal v2-install` needs to be used instead of `stack`. Configure `cabal` to enable profiling by setting `profiling: True` in `cabal.project.local` for all packages. If that file does not already exist, create it as follows: @@ -72,7 +72,7 @@ Then `hie` can be compiled for a specific GHC version: ```bash export GHCP= -cabal new-install exe:hie -w $GHCP \ +cabal v2-install exe:hie -w $GHCP \ --write-ghc-environment-files=never --symlink-bindir=$HOME/.local/bin \ --overwrite-policy=always --reinstall ``` From db23fa56ce231d267d0a2eefaf57950a55e7ce51 Mon Sep 17 00:00:00 2001 From: jneira Date: Fri, 15 Nov 2019 12:35:10 +0100 Subject: [PATCH 53/67] Correct typo --- docs/Build.md | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/docs/Build.md b/docs/Build.md index 222000888..83daebec2 100644 --- a/docs/Build.md +++ b/docs/Build.md @@ -28,10 +28,10 @@ See the project's `README` for detailed information about installing `hie`. The build script `install.hs` defines several targets using the `shake` build system. The targets are roughly: * `hie-*`: builds and installs the `hie` binaries. Also renames the binaries to contain the correct version-number. -* `build-latest`: builds ad installs `hie` for the latest available and supported `ghc` version. +* `build-latest`: builds and installs `hie` for the latest available and supported `ghc` version. * `build-all`: builds and installs `hie` binaries for all supported `ghc` versions. This option may take a long time and computer resources so use it with caution. * `build-data`: builds the hoogle-db required by `hie` -* `build`: builds ad installs `hie` for the latest supported `ghc` version (like `build-latest`) and the hoogle-db (like `build-data`) +* `build`: builds and installs `hie` for the latest supported `ghc` version (like `build-latest`) and the hoogle-db (like `build-data`) * `cabal-*`: execute the same task as the original target, but with `cabal` instead of `stack` Each `stack-*.yaml` contains references to packages in the submodules. Calling `stack` with one of those causes the build to fail if the submodules have not been initialized already. The file `shake.yaml` solves this issue invoking the `git` binary itself to update the submodules. Moreover, it specifies the correct version of `shake` and is used for installing all run-time dependencies such as `cabal` and `hoogle` if necessary. From 27fb514fa03e0398465c04503af874a012b2e7d5 Mon Sep 17 00:00:00 2001 From: jneira Date: Fri, 15 Nov 2019 12:40:59 +0100 Subject: [PATCH 54/67] Use existing exe function from Shake --- install/src/Env.hs | 11 +++++------ 1 file changed, 5 insertions(+), 6 deletions(-) diff --git a/install/src/Env.hs b/install/src/Env.hs index 45e9ebc01..c521d9923 100644 --- a/install/src/Env.hs +++ b/install/src/Env.hs @@ -8,7 +8,10 @@ import Development.Shake.FilePath import System.Info ( os , arch ) -import Data.Maybe ( isJust ) +import Data.Maybe ( isJust + , isNothing + , mapMaybe + ) import System.Directory ( findExecutable , findExecutables , listDirectory @@ -23,9 +26,7 @@ import Data.List ( sort ) import Data.Ord ( comparing ) import Control.Monad.Extra ( mapMaybeM ) -import Data.Maybe ( isNothing - , mapMaybe - ) + import qualified Data.Text as T import Version @@ -80,8 +81,6 @@ getGhcPathOf ghcVersion = liftIO $ findExecutable ("ghc-" ++ ghcVersion <.> exe) >>= \case Nothing -> lookup ghcVersion <$> getGhcPaths path -> return path - where exe | isWindowsSystem = "exe" - | otherwise = "" -- | Get a list of GHCs that are available in $PATH getGhcPaths :: MonadIO m => m [(VersionNumber, GhcPath)] From c63d0beca9870b63e4ba690eb037de4b97b46112 Mon Sep 17 00:00:00 2001 From: jneira Date: Fri, 15 Nov 2019 13:21:24 +0100 Subject: [PATCH 55/67] Test build-latest target --- .azure/linux-installhs-stack.yml | 4 ++++ .azure/macos-installhs-stack.yml | 4 ++++ .azure/windows-installhs-stack.yml | 4 ++++ 3 files changed, 12 insertions(+) diff --git a/.azure/linux-installhs-stack.yml b/.azure/linux-installhs-stack.yml index a3c340371..086354113 100644 --- a/.azure/linux-installhs-stack.yml +++ b/.azure/linux-installhs-stack.yml @@ -34,3 +34,7 @@ jobs: source .azure/linux.bashrc stack install.hs stack-install-cabal displayName: Run stack-install-cabal target of `install.hs` + - bash: | + source .azure/linux.bashrc + stack install.hs build-latest + displayName: Run build-latest target of `install.hs` diff --git a/.azure/macos-installhs-stack.yml b/.azure/macos-installhs-stack.yml index 1c5cc2c7b..e78e8f3dd 100644 --- a/.azure/macos-installhs-stack.yml +++ b/.azure/macos-installhs-stack.yml @@ -34,3 +34,7 @@ jobs: source .azure/macos.bashrc stack install.hs stack-install-cabal displayName: Run stack-install-cabal target of `install.hs` + - bash: | + source .azure/linux.bashrc + stack install.hs build-latest + displayName: Run build-latest target of `install.hs` diff --git a/.azure/windows-installhs-stack.yml b/.azure/windows-installhs-stack.yml index ccd660e3f..cec4fd2e3 100644 --- a/.azure/windows-installhs-stack.yml +++ b/.azure/windows-installhs-stack.yml @@ -32,3 +32,7 @@ jobs: source .azure/windows.bashrc stack install.hs stack-install-cabal displayName: Run stack-install-cabal target of `install.hs` + - bash: | + source .azure/linux.bashrc + stack install.hs build-latest + displayName: Run build-latest target of `install.hs` From ab1dde8135d280c553ba1190bcf582a0c7d13fa6 Mon Sep 17 00:00:00 2001 From: jneira Date: Fri, 15 Nov 2019 23:26:21 +0100 Subject: [PATCH 56/67] Remove build-all target --- README.md | 10 ++-------- docs/Build.md | 2 -- install/src/Help.hs | 23 +++-------------------- install/src/HieInstall.hs | 10 +--------- 4 files changed, 6 insertions(+), 39 deletions(-) diff --git a/README.md b/README.md index 667ef1105..c5de63bd2 100644 --- a/README.md +++ b/README.md @@ -244,12 +244,12 @@ stack ./install.hs hie-8.4.4 stack ./install.hs build-data ``` -The Haskell IDE Engine can also be built with `cabal new-build` instead of `stack build`. +The Haskell IDE Engine can also be built with `cabal v2-build` instead of `stack build`. This has the advantage that you can decide how the GHC versions have been installed. To see what GHC versions are available, the command `stack install.hs cabal-ghcs` can be used. It will list all GHC versions that are on the path and their respective installation directory. If you think, this list is incomplete, you can try to modify the PATH variable, such that the executables can be found. -Note, that the targets `cabal-build`, `cabal-build-data` and `cabal-build-all` depend on the found GHC versions. +Note, that the targets `cabal-build` and `cabal-build-data` depend on the found GHC versions. They install Haskell IDE Engine only for the found GHC versions. An example output is: @@ -271,12 +271,6 @@ stack install.hs cabal-hie-8.4.4 stack install.hs cabal-build-data ``` -To install HIE for all GHC versions that are present on your system, use: - -```bash -stack ./install.hs cabal-build-all -``` - In general, targets that use `cabal` instead of `stack` are prefixed with `cabal-*` and are identical to their counterpart, except they do not install a GHC if it is missing but fail. ##### Multiple versions of HIE (optional) diff --git a/docs/Build.md b/docs/Build.md index 83daebec2..717f779aa 100644 --- a/docs/Build.md +++ b/docs/Build.md @@ -13,7 +13,6 @@ The design of the build system has the following main goals: - `stack` - `git` * is completely functional right after a simple `git clone` and after every `git pull` -* one-stop-shop for building and naming all executables required for using `hie` in IDEs. * prevents certain build failures by either identifying a failed precondition (such as wrong `stack` version) or by performing the necessary steps so users can't forget them (such as invoking `git` to update submodules) @@ -29,7 +28,6 @@ The build script `install.hs` defines several targets using the `shake` build sy * `hie-*`: builds and installs the `hie` binaries. Also renames the binaries to contain the correct version-number. * `build-latest`: builds and installs `hie` for the latest available and supported `ghc` version. -* `build-all`: builds and installs `hie` binaries for all supported `ghc` versions. This option may take a long time and computer resources so use it with caution. * `build-data`: builds the hoogle-db required by `hie` * `build`: builds and installs `hie` for the latest supported `ghc` version (like `build-latest`) and the hoogle-db (like `build-data`) * `cabal-*`: execute the same task as the original target, but with `cabal` instead of `stack` diff --git a/install/src/Help.hs b/install/src/Help.hs index cb335d4db..02b529c8e 100644 --- a/install/src/Help.hs +++ b/install/src/Help.hs @@ -45,7 +45,7 @@ shortHelpMessage = do [ ("help", "Show help message including all targets") , emptyTarget , buildTarget - , buildAllTarget + , buildLatestTarget , hieTarget $ last hieVersions , buildDataTarget , cabalGhcsTarget @@ -86,13 +86,12 @@ helpMessage versions@BuildableVersions {..} = do -- All targets with their respective help message. generalTargets = [helpTarget] - defaultTargets = [buildTarget, buildLatestTarget, buildAllTarget, buildDataTarget] + defaultTargets = [buildTarget, buildLatestTarget, buildDataTarget] ++ map hieTarget (getDefaultBuildSystemVersions versions) stackTargets = [ stackTarget buildTarget , stackTarget buildLatestTarget - , stackTarget buildAllTarget , stackTarget buildDataTarget ] ++ (if isRunFromStack then [stackTarget installCabalTarget] else []) @@ -102,7 +101,6 @@ helpMessage versions@BuildableVersions {..} = do [ cabalGhcsTarget , cabalTarget buildTarget , cabalTarget buildLatestTarget - , cabalTarget buildAllTarget , cabalTarget buildDataTarget ] ++ map (cabalTarget . hieTarget) cabalVersions @@ -138,21 +136,6 @@ buildDataTarget :: TargetDescription buildDataTarget = ("build-data", "Get the required data-files for `hie` (Hoogle DB)") -buildAllTarget :: TargetDescription -buildAllTarget = - ( "build-all" - , "Builds hie for all installed GHC versions and the data files. " - ++ buildAllWarning) - -buildAllWarning :: String -buildAllWarning = "WARNING: This command may take a long time and computer resources" - -buildAllWarningAlt :: String -buildAllWarningAlt = "Consider building only the ghc versions you need using:\n" - ++ " " ++ buildCommand (hieTarget "") ++ "\n" - ++ "or the latest available one with:\n" - ++ " " ++ buildCommand buildLatestTarget ++ "\n" - -- special targets macosIcuTarget :: TargetDescription @@ -164,7 +147,7 @@ helpTarget = ("help", "Show help message including all targets") cabalGhcsTarget :: TargetDescription cabalGhcsTarget = ( "cabal-ghcs" - , "Show all GHC versions that can be installed via `cabal-build` and `cabal-build-all`." + , "Show all GHC versions that can be installed via `cabal-build`." ) installCabalTarget :: TargetDescription diff --git a/install/src/HieInstall.hs b/install/src/HieInstall.hs index 479e59cf9..f3e12e57b 100644 --- a/install/src/HieInstall.hs +++ b/install/src/HieInstall.hs @@ -85,7 +85,6 @@ defaultMain = do -- default-targets phony "build" $ need [buildSystem ++ "-build"] phony "build-latest" $ need [buildSystem ++ "-build-latest"] - phony "build-all" $ need [buildSystem ++ "-build-all"] phony "build-data" $ need [buildSystem ++ "-build-data"] forM_ (getDefaultBuildSystemVersions versions) @@ -97,10 +96,7 @@ defaultMain = do when isRunFromStack (phony "stack-install-cabal" (need ["cabal"])) phony "stack-build-latest" (need ["stack-hie-" ++ last hieVersions]) phony "stack-build" (need ["build-data", "stack-build-latest"]) - phony "stack-build-all" $ do - printInStars (buildAllWarning ++ ".\n" ++ buildAllWarningAlt) - need (["build-data"] ++ (reverse $ map ("stack-hie-" ++) hieVersions)) - + phony "stack-build-data" $ do need ["submodules"] need ["check-stack"] @@ -117,10 +113,6 @@ defaultMain = do -- cabal specific targets phony "cabal-build-latest" (need ["cabal-hie-" ++ last ghcVersions]) phony "cabal-build" (need ["build-data", "cabal-build-latest"]) - phony "cabal-build-all" $ do - printInStars (buildAllWarning ++ ".\n" ++ buildAllWarningAlt) - need (["cabal-build-data"] ++ (map ("cabal-hie-" ++) ghcVersions)) - phony "cabal-build-data" $ do need ["submodules"] need ["cabal"] From bb7c702a41971d0ba24b94a29bcd0862adc76b89 Mon Sep 17 00:00:00 2001 From: Alan Zimmerman Date: Fri, 15 Nov 2019 18:42:19 +0000 Subject: [PATCH 57/67] Bump haskell-lsp et al to 0.18.0.0 --- haskell-ide-engine.cabal | 10 ++--- .../Haskell/Ide/Engine/PluginUtils.hs | 2 +- hie-plugin-api/hie-plugin-api.cabal | 2 +- src/Haskell/Ide/Engine/Transport/LspStdio.hs | 45 +++++++++++++------ stack-8.4.2.yaml | 6 +-- stack-8.4.3.yaml | 6 +-- stack-8.4.4.yaml | 6 +-- stack-8.6.1.yaml | 6 +-- stack-8.6.2.yaml | 6 +-- stack-8.6.3.yaml | 6 +-- stack-8.6.4.yaml | 6 +-- stack-8.6.5.yaml | 6 +-- stack.yaml | 6 +-- 13 files changed, 66 insertions(+), 47 deletions(-) diff --git a/haskell-ide-engine.cabal b/haskell-ide-engine.cabal index 8465147eb..3415552df 100644 --- a/haskell-ide-engine.cabal +++ b/haskell-ide-engine.cabal @@ -71,8 +71,8 @@ library , gitrev >= 1.1 , haddock-api , haddock-library - , haskell-lsp == 0.17.* - , haskell-lsp-types == 0.17.* + , haskell-lsp == 0.18.* + , haskell-lsp-types == 0.18.* , haskell-src-exts , hie-plugin-api , hoogle >= 5.0.13 @@ -196,7 +196,7 @@ test-suite unit-test , free , ghc , haskell-ide-engine - , haskell-lsp-types == 0.17.* + , haskell-lsp-types == 0.18.* , hie-test-utils , hie-plugin-api , hoogle > 5.0.11 @@ -285,8 +285,8 @@ test-suite func-test , filepath , lsp-test >= 0.8.0.0 , haskell-ide-engine - , haskell-lsp-types == 0.17.* - , haskell-lsp == 0.17.* + , haskell-lsp-types == 0.18.* + , haskell-lsp == 0.18.* , hie-test-utils , hie-plugin-api , hspec diff --git a/hie-plugin-api/Haskell/Ide/Engine/PluginUtils.hs b/hie-plugin-api/Haskell/Ide/Engine/PluginUtils.hs index 557ec615a..6d4286948 100644 --- a/hie-plugin-api/Haskell/Ide/Engine/PluginUtils.hs +++ b/hie-plugin-api/Haskell/Ide/Engine/PluginUtils.hs @@ -275,7 +275,7 @@ readVFS :: (MonadIde m, MonadIO m) => Uri -> m (Maybe T.Text) readVFS uri = do mvf <- getVirtualFile uri case mvf of - Just (VirtualFile _ txt _) -> return $ Just (Rope.toText txt) + Just (VirtualFile _ txt) -> return $ Just (Rope.toText txt) Nothing -> return Nothing getRangeFromVFS :: (MonadIde m, MonadIO m) => Uri -> Range -> m (Maybe T.Text) diff --git a/hie-plugin-api/hie-plugin-api.cabal b/hie-plugin-api/hie-plugin-api.cabal index 02759d407..4c496f622 100644 --- a/hie-plugin-api/hie-plugin-api.cabal +++ b/hie-plugin-api/hie-plugin-api.cabal @@ -45,7 +45,7 @@ library , ghc , ghc-mod-core >= 5.9.0.0 , ghc-project-types >= 5.9.0.0 - , haskell-lsp == 0.17.* + , haskell-lsp == 0.18.* , hslogger , monad-control , mtl diff --git a/src/Haskell/Ide/Engine/Transport/LspStdio.hs b/src/Haskell/Ide/Engine/Transport/LspStdio.hs index 52aa4b137..6a6f284c2 100644 --- a/src/Haskell/Ide/Engine/Transport/LspStdio.hs +++ b/src/Haskell/Ide/Engine/Transport/LspStdio.hs @@ -30,6 +30,7 @@ import qualified Data.ByteString.Lazy as BL import Data.Coerce (coerce) import Data.Default import Data.Foldable +import Data.List.NonEmpty ( nonEmpty ) import qualified Data.Map as Map import Data.Maybe import Data.Semigroup (Semigroup(..), Option(..), option) @@ -219,8 +220,8 @@ mapFileFromVfs tn vtdi = do vfsFunc <- asksLspFuncs Core.getVirtualFileFunc mvf <- liftIO $ vfsFunc (J.toNormalizedUri uri) case (mvf, uriToFilePath uri) of - (Just (VFS.VirtualFile _ yitext _), Just fp) -> do - let text' = Rope.toString yitext + (Just (VFS.VirtualFile _ rope), Just fp) -> do + let text' = Rope.toString rope -- text = "{-# LINE 1 \"" ++ fp ++ "\"#-}\n" <> text' let req = GReq tn (Just uri) Nothing Nothing (const $ return ()) $ IdeResultOk <$> do @@ -798,7 +799,7 @@ withDocumentContents reqId uri f = do (J.responseId reqId) J.InvalidRequest "Document was not open" - Just (VFS.VirtualFile _ txt _) -> f (Rope.toText txt) + Just (VFS.VirtualFile _ txt) -> f (Rope.toText txt) -- | Get the currently configured formatter provider. -- The currently configured formatter provider is defined in @Config@ by PluginId. @@ -966,16 +967,34 @@ syncOptions = J.TextDocumentSyncOptions hieOptions :: [T.Text] -> Core.Options hieOptions commandIds = def { Core.textDocumentSync = Just syncOptions - , Core.completionProvider = Just (J.CompletionOptions (Just True) (Just ["."])) - -- As of 2018-05-24, vscode needs the commands to be registered - -- otherwise they will not be available as codeActions (will be - -- silently ignored, despite UI showing to the contrary). - -- - -- Hopefully the end May 2018 vscode release will stabilise - -- this, it is a major rework of the machinery anyway. - , Core.executeCommandProvider = Just (J.ExecuteCommandOptions (J.List commandIds)) - , Core.renameProvider = Just (J.RenameOptions (Just True)) - , Core.implementationProvider = Just (J.GotoOptionsStatic True) + -- The characters that trigger completion automatically. + , Core.completionTriggerCharacters = Just ['.'] + + -- The list of all possible characters that commit a completion. This field can be used + -- if clients don't support individual commmit characters per completion item. See + -- `_commitCharactersSupport`. + -- , completionAllCommitCharacters :: Maybe [Char] + + -- The characters that trigger signature help automatically. + -- , signatureHelpTriggerCharacters :: Maybe [Char] + + -- List of characters that re-trigger signature help. + -- These trigger characters are only active when signature help is already showing. All trigger characters + -- are also counted as re-trigger characters. + -- , signatureHelpRetriggerCharacters :: Maybe [Char] + + -- CodeActionKinds that this server may return. + -- The list of kinds may be generic, such as `CodeActionKind.Refactor`, or the server + -- may list out every specific kind they provide. + -- , codeActionKinds :: Maybe [J.CodeActionKind] + + -- The list of characters that triggers on type formatting. + -- If you set `documentOnTypeFormattingHandler`, you **must** set this. + , Core.documentOnTypeFormattingTriggerCharacters = nonEmpty [] + + -- The commands to be executed on the server. + -- If you set `executeCommandHandler`, you **must** set this. + , Core.executeCommandCommands = Just commandIds } diff --git a/stack-8.4.2.yaml b/stack-8.4.2.yaml index f7d20a309..25a572777 100644 --- a/stack-8.4.2.yaml +++ b/stack-8.4.2.yaml @@ -19,14 +19,14 @@ extra-deps: - ghc-lib-parser-8.8.1 - haddock-api-2.20.0 - haddock-library-1.6.0 -- haskell-lsp-0.17.0.0 -- haskell-lsp-types-0.17.0.0 +- haskell-lsp-0.18.0.0 +- haskell-lsp-types-0.18.0.0 - haskell-src-exts-1.21.1 - haskell-src-exts-util-0.2.5 - hlint-2.2.3 - hoogle-5.0.17.11 - hsimport-0.11.0 -- lsp-test-0.8.0.0 +- lsp-test-0.8.2.0 - monad-dijkstra-0.1.1.2 - pretty-show-1.8.2 - rope-utf16-splay-0.3.1.0 diff --git a/stack-8.4.3.yaml b/stack-8.4.3.yaml index 728ba2efd..8b912ef1c 100644 --- a/stack-8.4.3.yaml +++ b/stack-8.4.3.yaml @@ -19,14 +19,14 @@ extra-deps: - ghc-lib-parser-8.8.1 - haddock-api-2.20.0 - haddock-library-1.6.0 -- haskell-lsp-0.17.0.0 -- haskell-lsp-types-0.17.0.0 +- haskell-lsp-0.18.0.0 +- haskell-lsp-types-0.18.0.0 - haskell-src-exts-1.21.1 - haskell-src-exts-util-0.2.5 - hlint-2.2.3 - hoogle-5.0.17.11 - hsimport-0.11.0 -- lsp-test-0.8.0.0 +- lsp-test-0.8.2.0 - monad-dijkstra-0.1.1.2 - pretty-show-1.8.2 - rope-utf16-splay-0.3.1.0 diff --git a/stack-8.4.4.yaml b/stack-8.4.4.yaml index 05258f8d0..b820d620c 100644 --- a/stack-8.4.4.yaml +++ b/stack-8.4.4.yaml @@ -18,14 +18,14 @@ extra-deps: - ghc-lib-parser-8.8.1 - haddock-api-2.20.0 - haddock-library-1.6.0 -- haskell-lsp-0.17.0.0 -- haskell-lsp-types-0.17.0.0 +- haskell-lsp-0.18.0.0 +- haskell-lsp-types-0.18.0.0 - haskell-src-exts-1.21.1 - haskell-src-exts-util-0.2.5 - hlint-2.2.3 - hoogle-5.0.17.11 - hsimport-0.11.0 -- lsp-test-0.8.0.0 +- lsp-test-0.8.2.0 - monad-dijkstra-0.1.1.2 - optparse-simple-0.1.0 - pretty-show-1.9.5 diff --git a/stack-8.6.1.yaml b/stack-8.6.1.yaml index 08b24e7be..be46a7c88 100644 --- a/stack-8.6.1.yaml +++ b/stack-8.6.1.yaml @@ -22,14 +22,14 @@ extra-deps: - floskell-0.10.1 - ghc-lib-parser-8.8.1 - haddock-api-2.21.0 -- haskell-lsp-0.17.0.0 -- haskell-lsp-types-0.17.0.0 +- haskell-lsp-0.18.0.0 +- haskell-lsp-types-0.18.0.0 - haskell-src-exts-1.21.1 - haskell-src-exts-util-0.2.5 - hlint-2.2.3 - hoogle-5.0.17.11 - hsimport-0.11.0 -- lsp-test-0.8.0.0 +- lsp-test-0.8.2.0 - monad-dijkstra-0.1.1.2 - monad-memo-0.4.1 - monoid-subclasses-0.4.6.1 diff --git a/stack-8.6.2.yaml b/stack-8.6.2.yaml index 8228d8591..87bb2c771 100644 --- a/stack-8.6.2.yaml +++ b/stack-8.6.2.yaml @@ -18,14 +18,14 @@ extra-deps: - floskell-0.10.1 - ghc-lib-parser-8.8.1 - haddock-api-2.21.0 -- haskell-lsp-0.17.0.0 -- haskell-lsp-types-0.17.0.0 +- haskell-lsp-0.18.0.0 +- haskell-lsp-types-0.18.0.0 - haskell-src-exts-1.21.1 - haskell-src-exts-util-0.2.5 - hlint-2.2.3 - hoogle-5.0.17.11 - hsimport-0.11.0 -- lsp-test-0.8.0.0 +- lsp-test-0.8.2.0 - monad-dijkstra-0.1.1.2 - monad-memo-0.4.1 - multistate-0.8.0.1 diff --git a/stack-8.6.3.yaml b/stack-8.6.3.yaml index a7d8a85c2..c980dc1b4 100644 --- a/stack-8.6.3.yaml +++ b/stack-8.6.3.yaml @@ -17,14 +17,14 @@ extra-deps: - floskell-0.10.1 - ghc-lib-parser-8.8.1 - haddock-api-2.21.0 -- haskell-lsp-0.17.0.0 -- haskell-lsp-types-0.17.0.0 +- haskell-lsp-0.18.0.0 +- haskell-lsp-types-0.18.0.0 - haskell-src-exts-1.21.1 - haskell-src-exts-util-0.2.5 - hlint-2.2.3 - hoogle-5.0.17.11 - hsimport-0.11.0 -- lsp-test-0.8.0.0 +- lsp-test-0.8.2.0 - monad-dijkstra-0.1.1.2 - monad-memo-0.4.1 - multistate-0.8.0.1 diff --git a/stack-8.6.4.yaml b/stack-8.6.4.yaml index adea017a2..521474b0e 100644 --- a/stack-8.6.4.yaml +++ b/stack-8.6.4.yaml @@ -17,13 +17,13 @@ extra-deps: - floskell-0.10.1 - ghc-lib-parser-8.8.1 - haddock-api-2.22.0 -- haskell-lsp-0.17.0.0 -- haskell-lsp-types-0.17.0.0 +- haskell-lsp-0.18.0.0 +- haskell-lsp-types-0.18.0.0 - haskell-src-exts-1.21.1 - hlint-2.2.3 - hoogle-5.0.17.11 - hsimport-0.11.0 -- lsp-test-0.8.0.0 +- lsp-test-0.8.2.0 - monad-dijkstra-0.1.1.2@rev:1 - 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 3bf0af29f..73e7a010b 100644 --- a/stack-8.6.5.yaml +++ b/stack-8.6.5.yaml @@ -18,12 +18,12 @@ extra-deps: - floskell-0.10.1 - ghc-lib-parser-8.8.1 - haddock-api-2.22.0 -- haskell-lsp-0.17.0.0 -- haskell-lsp-types-0.17.0.0 +- haskell-lsp-0.18.0.0 +- haskell-lsp-types-0.18.0.0 - hlint-2.2.3 - hsimport-0.11.0 - hoogle-5.0.17.11 -- lsp-test-0.8.0.0 +- lsp-test-0.8.2.0 - monad-dijkstra-0.1.1.2@rev:1 - syz-0.2.0.0 - temporary-1.2.1.1 diff --git a/stack.yaml b/stack.yaml index 0acbf41fa..37fc5655d 100644 --- a/stack.yaml +++ b/stack.yaml @@ -18,11 +18,11 @@ extra-deps: - floskell-0.10.1 - ghc-lib-parser-8.8.1 - haddock-api-2.22.0 -- haskell-lsp-0.17.0.0 -- haskell-lsp-types-0.17.0.0 +- haskell-lsp-0.18.0.0 +- haskell-lsp-types-0.18.0.0 - hlint-2.2.3 - hsimport-0.11.0 -- lsp-test-0.8.0.0 +- lsp-test-0.8.2.0 - monad-dijkstra-0.1.1.2@rev:1 - syz-0.2.0.0 - temporary-1.2.1.1 From 0ae693639716d7209478c904b75ac64751333b24 Mon Sep 17 00:00:00 2001 From: jneira Date: Mon, 18 Nov 2019 00:19:21 +0100 Subject: [PATCH 58/67] Use builtin splitSearchPath --- install/src/Stack.hs | 12 +++--------- 1 file changed, 3 insertions(+), 9 deletions(-) diff --git a/install/src/Stack.hs b/install/src/Stack.hs index 96cd18334..dd054f93e 100644 --- a/install/src/Stack.hs +++ b/install/src/Stack.hs @@ -7,7 +7,7 @@ import Control.Exception import Control.Monad import Data.List import System.Directory ( copyFile ) -import System.FilePath ( searchPathSeparator, () ) +import System.FilePath ( splitSearchPath, searchPathSeparator, () ) import System.Environment ( lookupEnv, setEnv, getEnvironment ) import System.IO.Error ( isDoesNotExistError ) import BuildSystem @@ -124,13 +124,7 @@ withoutStackCachedBinaries action = do otherwise -> action where removePathsContaining strs path = - joinPaths (filter (not . containsAny) (splitPaths path)) + joinPaths (filter (not . containsAny) (splitSearchPath path)) where containsAny p = any (`isInfixOf` p) strs - joinPaths = intercalate [searchPathSeparator] - - splitPaths s = - case dropWhile (== searchPathSeparator) s of - "" -> [] - s' -> w : splitPaths s'' - where (w, s'') = break (== searchPathSeparator) s' + joinPaths = intercalate [searchPathSeparator] \ No newline at end of file From f37b98714e53bb90807951fbb95f91e3f2e6e79b Mon Sep 17 00:00:00 2001 From: jneira Date: Mon, 18 Nov 2019 08:34:55 +0100 Subject: [PATCH 59/67] Make clear requirements for cabal --- docs/Build.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/docs/Build.md b/docs/Build.md index 717f779aa..06f7a8190 100644 --- a/docs/Build.md +++ b/docs/Build.md @@ -89,7 +89,7 @@ The final step is to configure the `hie` client to use a custom `hie-wrapper` sc The `install.hs` script performs some checks to ensure that a correct installation is possible and provide meaningful error messages for known issues. * `stack` needs to be up-to-date. Version `1.9.3` is required -* `cabal` needs to be up-to-date. Version `3.0.0.0` is required for windows systems and `2.4.1.0` for other ones. +* `cabal` needs to be up-to-date. Version `2.4.1.0` is required to *use* haskell-ide-engine until the pull request #1126 is merged. Unfortunately cabal version `3.0.0.0` is needed to *install* hie in windows systems but that inconsistence will be fixed by the mentioned pull request. * `ghc-8.6.3` is broken on windows. Trying to install `hie-8.6.3` on windows is not possible. * When the build fails, an error message, that suggests to remove `.stack-work` directory, is displayed. From e839e89e93b6405d25c6b9dc55b87308836bd0b6 Mon Sep 17 00:00:00 2001 From: flip111 Date: Mon, 18 Nov 2019 13:33:57 +0100 Subject: [PATCH 60/67] Update README.md I had to look up an additional website where specifically to find this policy. I clarified this in the readme. --- README.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/README.md b/README.md index 0a1d4aba7..db906f9aa 100644 --- a/README.md +++ b/README.md @@ -176,7 +176,7 @@ sudo dnf install libicu-devel ncurses-devel In order to avoid problems with long paths on Windows you can do the following: -1. Edit the group policy: set "Enable Win32 long paths" to "Enabled" (Works +1. In the `Local Group Policy Editor`: `Local Computer Policy -> Computer Configuration -> Administrative Templates -> System -> Filesystem` set `Enable Win32 long paths` to `Enabled` (Works only for Windows 10). 2. Clone the `haskell-ide-engine` to the root of your logical drive (e.g. to From b77dadc1253f5ac2f77db630d66683597aa3fe81 Mon Sep 17 00:00:00 2001 From: bChiquet Date: Tue, 19 Nov 2019 11:58:34 +0100 Subject: [PATCH 61/67] last comma in the json object doesn't parse. Some JSON parsing tools won't accept the last comma in an object. --- README.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/README.md b/README.md index db906f9aa..493eb2268 100644 --- a/README.md +++ b/README.md @@ -407,7 +407,7 @@ Then issue `:CocConfig` and add the following to your Coc config file. "initializationOptions": { "languageServerHaskell": { } - }, + } } } ``` From 756d51df959dceb76bcef5201d88eea237fbad80 Mon Sep 17 00:00:00 2001 From: jneira Date: Tue, 19 Nov 2019 12:52:49 +0100 Subject: [PATCH 62/67] Use ghc versions from stack-*.yaml files --- install/src/Env.hs | 14 +++----------- 1 file changed, 3 insertions(+), 11 deletions(-) diff --git a/install/src/Env.hs b/install/src/Env.hs index c521d9923..cd8a296bd 100644 --- a/install/src/Env.hs +++ b/install/src/Env.hs @@ -43,15 +43,6 @@ existsExecutable executable = liftIO $ isJust <$> findExecutable executable isWindowsSystem :: Bool isWindowsSystem = os `elem` ["mingw32", "win32"] --- | Defines all different hie versions that are supported. --- On windows, `8.6.3` is excluded as this version of ghc does not work there -supportedGhcVersions :: [VersionNumber] -supportedGhcVersions = sort (commonVersions ++ osVersions) - where commonVersions = ["8.4.2", "8.4.3", "8.4.4", "8.6.1", "8.6.2", "8.6.4", "8.6.5"] - -- the following lines exclude `8.6.3` on windows systems - osVersions | isWindowsSystem = [] - | otherwise = ["8.6.3"] - findInstalledGhcs :: IO [(VersionNumber, GhcPath)] findInstalledGhcs = do hieVersions <- getHieVersions :: IO [VersionNumber] @@ -62,7 +53,7 @@ findInstalledGhcs = do ) (reverse hieVersions) -- filter out not supported ghc versions - availableGhcs <- filter ((`elem` supportedGhcVersions) . fst) <$> getGhcPaths + availableGhcs <- filter ((`elem` hieVersions) . fst) <$> getGhcPaths return -- sort by version to make it coherent with getHieVersions $ sortBy (comparing fst) @@ -113,7 +104,8 @@ getHieVersions = do & mapMaybe (T.stripPrefix stackYamlPrefix >=> T.stripSuffix stackYamlSuffix) & map T.unpack - & filter (\p -> p `elem` supportedGhcVersions) + -- the following line excludes `8.6.3` on windows systems + & filter (\p -> not isWindowsSystem || p /= "8.6.3") & sort return hieVersions From cd27b1ebd5c0745a29fd6d31f45e4b57e581e87e Mon Sep 17 00:00:00 2001 From: jneira Date: Tue, 19 Nov 2019 13:21:07 +0100 Subject: [PATCH 63/67] Correct per-os bashrc in win and macos --- .azure/macos-installhs-stack.yml | 2 +- .azure/windows-installhs-stack.yml | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/.azure/macos-installhs-stack.yml b/.azure/macos-installhs-stack.yml index e78e8f3dd..df7296193 100644 --- a/.azure/macos-installhs-stack.yml +++ b/.azure/macos-installhs-stack.yml @@ -35,6 +35,6 @@ jobs: stack install.hs stack-install-cabal displayName: Run stack-install-cabal target of `install.hs` - bash: | - source .azure/linux.bashrc + source .azure/macos.bashrc stack install.hs build-latest displayName: Run build-latest target of `install.hs` diff --git a/.azure/windows-installhs-stack.yml b/.azure/windows-installhs-stack.yml index cec4fd2e3..4dfed9e9d 100644 --- a/.azure/windows-installhs-stack.yml +++ b/.azure/windows-installhs-stack.yml @@ -33,6 +33,6 @@ jobs: stack install.hs stack-install-cabal displayName: Run stack-install-cabal target of `install.hs` - bash: | - source .azure/linux.bashrc + source .azure/windows.bashrc stack install.hs build-latest displayName: Run build-latest target of `install.hs` From e9d3322a241288133cb58a519e604fb37ade48ec Mon Sep 17 00:00:00 2001 From: Luke Lau Date: Tue, 19 Nov 2019 15:59:25 +0000 Subject: [PATCH 64/67] Add a comment about where to find docs for Core.Options --- src/Haskell/Ide/Engine/Transport/LspStdio.hs | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/src/Haskell/Ide/Engine/Transport/LspStdio.hs b/src/Haskell/Ide/Engine/Transport/LspStdio.hs index 576bdc797..ab7f9a022 100644 --- a/src/Haskell/Ide/Engine/Transport/LspStdio.hs +++ b/src/Haskell/Ide/Engine/Transport/LspStdio.hs @@ -963,6 +963,10 @@ syncOptions = J.TextDocumentSyncOptions , J._save = Just $ J.SaveOptions $ Just False } +-- | Create 'Language.Haskell.LSP.Core.Options'. +-- There may need to be more options configured, depending on what handlers +-- are registered. +-- Consult the haskell-lsp haddocks to see all possible options. hieOptions :: [T.Text] -> Core.Options hieOptions commandIds = def { Core.textDocumentSync = Just syncOptions From d4672648e159235381d63a6abed736f63ec59c3a Mon Sep 17 00:00:00 2001 From: Matthew Pickering Date: Tue, 19 Nov 2019 22:15:11 +0000 Subject: [PATCH 65/67] Remove writeMTS --- hie-plugin-api/Haskell/Ide/Engine/MultiThreadState.hs | 2 -- 1 file changed, 2 deletions(-) diff --git a/hie-plugin-api/Haskell/Ide/Engine/MultiThreadState.hs b/hie-plugin-api/Haskell/Ide/Engine/MultiThreadState.hs index 28bba128a..0d59a6752 100644 --- a/hie-plugin-api/Haskell/Ide/Engine/MultiThreadState.hs +++ b/hie-plugin-api/Haskell/Ide/Engine/MultiThreadState.hs @@ -33,8 +33,6 @@ runMTState m s = do class MonadIO m => MonadMTState s m | m -> s where readMTS :: m s modifyMTS :: (s -> s) -> m () - writeMTS :: s -> m () - writeMTS s = modifyMTS (const s) instance MonadMTState s (MultiThreadState s) where readMTS = readMTState From 8c3c3503ce5bc23e767fbb57be980c9b482c9930 Mon Sep 17 00:00:00 2001 From: Matthew Pickering Date: Tue, 19 Nov 2019 22:45:23 +0000 Subject: [PATCH 66/67] Fix HaRe submodule --- .gitmodules | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.gitmodules b/.gitmodules index ae413540c..ef5db71b7 100644 --- a/.gitmodules +++ b/.gitmodules @@ -12,7 +12,7 @@ [submodule "submodules/HaRe"] path = submodules/HaRe - url = https://github.com/wz1000/HaRe.git + url = https://github.com/alanz/HaRe.git [submodule "submodules/cabal-helper"] path = submodules/cabal-helper From 4c5308b5ab35c1f9b224b95f99ec582f446c7052 Mon Sep 17 00:00:00 2001 From: Matthew Pickering Date: Tue, 19 Nov 2019 22:48:45 +0000 Subject: [PATCH 67/67] Remove eventlog, by default, should add a way to turn this on with a cabal flag --- haskell-ide-engine.cabal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/haskell-ide-engine.cabal b/haskell-ide-engine.cabal index e4db69360..540fe3ad4 100644 --- a/haskell-ide-engine.cabal +++ b/haskell-ide-engine.cabal @@ -119,7 +119,7 @@ executable hie , hslogger , optparse-simple ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall -Wredundant-constraints - -with-rtsopts=-T -eventlog + -with-rtsopts=-T if flag(pedantic) ghc-options: -Werror default-language: Haskell2010