From 0c99ce0411ed7bc3d43aa8a29c75f1e1fd9ee2bd Mon Sep 17 00:00:00 2001 From: Luke Lau Date: Mon, 20 Jul 2020 20:28:52 +0100 Subject: [PATCH] Distributable binaries (#165) Update ghcide to obtain the GHC lib dir at runtime, rather than at compile time with ghc-paths. This means that the binaries can be moved about since the lib dir is obtained on the fly Share the exe/main.hs logic between ghcide and hls: the session setup logic which previously took up most of exe/main.hs now resides inside the ghcide library, and is used by both ghcide and hls's executables Add a --project-ghc-version option to the wrapper which spits out the project's ghc version to stdout. This is useful for the vscode extension which can then use it to download the corresponding version of binary that the wrapper would have otherwise attempted to launch Make the wrapper check to see if the correct tool is installed beforehand. For example, if it detects a stack project but stack isn't on the path, it will report an error then and there, rather than having hls/ghcide confusingly fail later on. The vscode extension uses this new error message as well to provide a pop up message linking the user to a website to install the missing tool Remove cabal-helper from the wrapper, so that the implicit cradle logic is the same between ghcide/hls/hls-wrapper And of course, add a GitHub action workflow that runs whenever a release is created on GitHub that builds static binaries on Linux, and distributable enough binaries on macOS and windows. This is documented a bit more in docs/releases.md * WIP * WIP 2 * WIP 3 * WIP 4 * WIP 5 * WIP 6 * WIP 7 * WIP 8 * WIP 9 Use patched hie-bios to get libdir dynamically * Try building the wrapper * Try to fix build_wrapper env variable not being picked up * Try again * Give up on the env var idea * Try out static optimised builds? * Try squashing the working dir * Woops * Try squashing the builddir * Try going into the parent directory * Radical approach - don't use such a long name for the wrapper * Use dist-binary flag * Debug why floskell fails to build on windows * haskell-language-server => hls on CI I hate that I have to do this * Employ extreme path saving measures * sed time :( * Try making sed command portable * Compress artefacts * Tidy up wrapper logging * Use version checking logic in hie-bios * Add documentation on the releases process * Remove unused code * Append .exe to windows binaries * Try out building remaining supported ghc configurations * Add wrapper tests and update hie-bios * Use index timestamp that exists on hackage Fixes warning * Update hie-bios * Update hie-bios * Try building windows jobs on -j1 * Skip windows 8.8.2 * Update ghc-check to use hie-bios runtime ghc libdir * Upload binaries as an artifact too * Try flicking on enable-executable-static I don't expect this to work, puffnfresh has already tried this and had to fork ghcup * Fix artifact upload * Update to latest ghcide and reuse loadSession * Check if the tool is installed in --project-ghc-version in the wrapper * Fix wrapper tests by copying to temporary directory * Try caching * Tidy up and switch back to cabal helper implicit cradle * use split sections * Remove cabal-helper and replace it with hie-bios implicit logic The cabal-helper cradle was only used by the wrapper for detecting the project GHC version in the absence of an explicit hie.yaml file, whilst ghcide itself used the hie-bios implicit cradle logic. This brings the two in sync so the wrapper should behave more predictably now. * Undo agpl common stanza change * Add release number Co-authored-by: amesgen --- .github/workflows/build.yml | 116 +++ .gitignore | 3 + .gitmodules | 3 +- docs/releases.md | 72 ++ exe/Arguments.hs | 18 +- exe/Main.hs | 615 +----------- exe/Wrapper.hs | 136 +-- ghcide | 2 +- haskell-language-server.cabal | 36 +- src/Ide/Cradle.hs | 913 ------------------ src/Ide/Version.hs | 29 +- stack-8.10.1.yaml | 3 - stack-8.6.4.yaml | 1 - stack-8.6.5.yaml | 1 - stack-8.8.2.yaml | 1 - stack-8.8.3.yaml | 1 - stack.yaml | 1 - test/utils/Test/Hls/Util.hs | 56 +- test/wrapper/Main.hs | 33 + test/wrapper/testdata/cabal-cur-ver/Lib.hs | 2 + .../cabal-cur-ver/cabal-cur-ver.cabal | 7 + .../testdata/cabal-cur-ver/cabal.project | 1 + test/wrapper/testdata/stack-8.10.1/Lib.hs | 2 + test/wrapper/testdata/stack-8.10.1/foo.cabal | 7 + test/wrapper/testdata/stack-8.10.1/stack.yaml | 1 + test/wrapper/testdata/stack-8.8.3/Lib.hs | 2 + test/wrapper/testdata/stack-8.8.3/foo.cabal | 7 + test/wrapper/testdata/stack-8.8.3/stack.yaml | 1 + 28 files changed, 426 insertions(+), 1644 deletions(-) create mode 100644 .github/workflows/build.yml create mode 100644 docs/releases.md delete mode 100644 src/Ide/Cradle.hs create mode 100644 test/wrapper/Main.hs create mode 100644 test/wrapper/testdata/cabal-cur-ver/Lib.hs create mode 100644 test/wrapper/testdata/cabal-cur-ver/cabal-cur-ver.cabal create mode 100644 test/wrapper/testdata/cabal-cur-ver/cabal.project create mode 100644 test/wrapper/testdata/stack-8.10.1/Lib.hs create mode 100644 test/wrapper/testdata/stack-8.10.1/foo.cabal create mode 100644 test/wrapper/testdata/stack-8.10.1/stack.yaml create mode 100644 test/wrapper/testdata/stack-8.8.3/Lib.hs create mode 100644 test/wrapper/testdata/stack-8.8.3/foo.cabal create mode 100644 test/wrapper/testdata/stack-8.8.3/stack.yaml diff --git a/.github/workflows/build.yml b/.github/workflows/build.yml new file mode 100644 index 0000000000..3f05374956 --- /dev/null +++ b/.github/workflows/build.yml @@ -0,0 +1,116 @@ +name: Builds + +on: + release: + types: [created] +jobs: + + build: + runs-on: ${{ matrix.os }} + + strategy: + fail-fast: false + matrix: + ghc: ['8.10.1', '8.8.3', '8.8.2', '8.6.5', '8.6.4'] + os: [ubuntu-latest, macOS-latest, windows-latest] + exclude: + - os: windows-latest + ghc: '8.8.3' # fails due to segfault + - os: windows-latest + ghc: '8.8.2' # fails due to error with Cabal + + steps: + - uses: actions/checkout@v2 + with: + submodules: true + - uses: actions/setup-haskell@v1.1.1 + with: + ghc-version: ${{ matrix.ghc }} + cabal-version: '3.2' + + - name: Cache Cabal + uses: actions/cache@v1.2.0 + with: + path: ~/.cabal + key: ${{ runner.OS }}-${{ matrix.ghc }}-${{ hashFiles('**/*.cabal') }} + + - name: Shorten binary names + shell: bash + run: | + sed -i.bak -e 's/haskell-language-server/hls/g' \ + -e 's/haskell_language_server/hls/g' \ + haskell-language-server.cabal + sed -i.bak -e 's/Paths_haskell_language_server/Paths_hls/g' \ + src/**/*.hs exe/*.hs + + - name: Set some window specific things + if: matrix.os == 'windows-latest' + shell: bash + run: | + echo '::set-env name=EXE_EXT::.exe' + + - name: Set some linux specific things + if: matrix.os == 'ubuntu-latest' + run: | + echo '::set-env name=LINUX_CABAL_ARGS::--enable-executable-static --ghc-options=-split-sections' + + - name: Build Server + shell: bash + # Try building it twice in case of flakey builds on Windows + run: | + cabal build exe:hls -O2 --disable-documentation $LINUX_CABAL_ARGS || \ + cabal build exe:hls -O2 --disable-documentation $LINUX_CABAL_ARGS + + - name: Find Server Binary + id: find_server_binary + shell: bash + run: | + HLS=$(find dist-newstyle \( -name 'hls' -o -name 'hls.exe' \) -type f) + gzip --best $HLS + echo ::set-output name=hls_binary::$HLS.gz + + - name: Upload Server Binary + uses: actions/upload-release-asset@v1.0.2 + env: + GITHUB_TOKEN: ${{ secrets.GITHUB_TOKEN }} + with: + upload_url: ${{ github.event.release.upload_url }} + asset_path: ${{ steps.find_server_binary.outputs.hls_binary }} + asset_name: haskell-language-server-${{ runner.OS }}-${{ matrix.ghc }}${{env.EXE_EXT}}.gz + asset_content_type: application/gzip + + - uses: actions/upload-artifact@v2 + with: + name: haskell-language-server-${{ runner.OS }}-${{ matrix.ghc }}${{env.EXE_EXT}}.gz + path: ${{ steps.find_server_binary.outputs.hls_binary }} + + - name: Build Wrapper + if: matrix.ghc == '8.10.1' + run: cabal build exe:hls-wrapper -O2 --disable-documentation $WIN_CABAL_ARGS $LINUX_CABAL_ARGS + + - name: Find Wrapper Binary + if: matrix.ghc == '8.10.1' + id: find_wrapper_binary + shell: bash + run: | + HLS_WRAPPER=$(find dist-newstyle \( -name 'hls-wrapper' -o -name 'hls-wrapper.exe' \) -type f) + gzip --best $HLS_WRAPPER + echo ::set-output name=hls_wrapper_binary::$HLS_WRAPPER.gz + + - name: Upload Wrapper + if: matrix.ghc == '8.10.1' + uses: actions/upload-release-asset@v1.0.2 + env: + GITHUB_TOKEN: ${{ secrets.GITHUB_TOKEN }} + with: + upload_url: ${{ github.event.release.upload_url }} + asset_path: ${{ steps.find_wrapper_binary.outputs.hls_wrapper_binary }} + asset_name: haskell-language-server-wrapper-${{ runner.OS }}${{env.EXE_EXT}}.gz + asset_content_type: application/gzip + + - uses: actions/upload-artifact@v2 + if: matrix.ghc == '8.10.1' + with: + name: haskell-language-server-wrapper-${{ runner.OS }}${{env.EXE_EXT}}.gz + path: ${{ steps.find_wrapper_binary.outputs.hls_wrapper_binary }} + diff --git a/.gitignore b/.gitignore index 9058bdc494..2b61164aa0 100644 --- a/.gitignore +++ b/.gitignore @@ -19,5 +19,8 @@ shake.yaml.lock stack*.yaml.lock shake.yaml.lock +# ignore hie.yaml's for testdata +test/testdata/**/hie.yaml + # metadata files on macOS .DS_Store diff --git a/.gitmodules b/.gitmodules index c64555bbb2..839d96ebdc 100644 --- a/.gitmodules +++ b/.gitmodules @@ -13,4 +13,5 @@ # url = https://github.com/digital-asset/ghcide.git # url = https://github.com/alanz/ghcide.git # url = https://github.com/wz1000/ghcide.git - url = https://github.com/fendor/ghcide.git + # url = https://github.com/fendor/ghcide.git + url = https://github.com/bubba/ghcide.git diff --git a/docs/releases.md b/docs/releases.md new file mode 100644 index 0000000000..a8645c1950 --- /dev/null +++ b/docs/releases.md @@ -0,0 +1,72 @@ +# Releases and distributable binaries + +Starting with 0.3.0.0 haskell-language-server provides pre-built binaries on +each [GitHub +release](https://github.com/haskell/haskell-language-server/releases). These +binaries are used by the [vscode-hie-server +extension](https://github.com/alanz/vscode-hie-server) to provide automatic +installation for users on VS Code, but they can also be installed manually +when added to the path. + +## Making a new release of haskell-language-server + +Go to the [GitHub releases +page](https://github.com/haskell/haskell-language-server/releases) for +haskell-language-server and start to create a new release. Choose or create a +tag, fill out the release notes etc., but before you create it +**make sure to check the pre-release checkbox**. This will prevent VS Code +*extension +users from attempting to install this version before the binaries are +created. + +Once the release is created the [GitHub Actions +workflow](https://github.com/haskell/haskell-language-server/actions) will be +kicked off and will start creating binaries. They will be gzipped and +uploaded to the release. + +It creates a `haskell-language-server-OS-GHC` binary for each platform +(Linux, macOS, Windows) and each GHC version that we currently support, as well +as a `haskell-language-server-wrapper-OS` binary for each platform. Note that +only one wrapper binary is created per platform, and it should be built with the +most recent GHC version. + +Once all these binaries are present + +## Distributable binaries +In order to compile a hls binary on one machine and have it run on another, you +need to make sure there are **no hardcoded paths or data-files**. + +### ghc libdir +One noteable thing which cannot be hardcoded is the **GHC libdir** – this is +a path to `/usr/local/lib/ghc` or something like that, which was previously +baked in at compile-time with ghc-paths. Note that with static binaries we +can no longer use this because the GHC libdir of the GitHub Actions machine +will most almost certainly not exist on the end user's machine. +Therefore, hie-bios provides `getGhcRuntimeLibDir` to obtain this path on the fly +by consulting the cradle. + +### Static binaries +We use the word "distributable" here because technically only the Linux builds +are static. They are built by passing `--enable-executable-static` to cabal. +Static binaries don't really exist on macOS, and there are issues with +proprietary code being linked in on Windows. However, the `.dylib`s linked on +macOS are all already provided by the system: + +``` +$ objdump -macho --dylibs-used haskell-language-server +haskell-language-server: + /usr/lib/libncurses.5.4.dylib (compatibility version 5.4.0, current version 5.4.0) + /usr/lib/libiconv.2.dylib (compatibility version 7.0.0, current version 7.0.0) + /usr/lib/libSystem.B.dylib (compatibility version 1.0.0, current version 1281.100.1) + /usr/lib/libcharset.1.dylib (compatibility version 2.0.0, current version 2.0.0) +``` + +## The GitHub Actions workflow +It just kicks off a matrix of jobs varying across GHC versions and OSs, building +the binaries with Cabal and extracting them from the dist-newstyle directory. +The binaries are built with -O2. + +One caveat is that we need to rename the binaries from +haskell-language-server/haskell-language-server-wrapper to hls/hls-wrapper due to +path length limitations on windows. But whenever we upload them to the release, +we make sure to upload them as their full name variant. diff --git a/exe/Arguments.hs b/exe/Arguments.hs index 1dcf3e6da0..81e388d3de 100644 --- a/exe/Arguments.hs +++ b/exe/Arguments.hs @@ -10,14 +10,11 @@ module Arguments ( Arguments(..) , getArguments - , ghcideVersion - , getLibdir + , haskellLanguageServerVersion ) where -import Data.Maybe import Data.Version import Development.GitRev -import qualified GHC.Paths import Options.Applicative import Paths_haskell_language_server import System.Environment @@ -37,6 +34,7 @@ data Arguments = Arguments , argsDebugOn :: Bool , argsLogFile :: Maybe String , argsThreads :: Int + , argsProjectGhcVersion :: Bool } deriving Show getArguments :: String -> IO Arguments @@ -80,21 +78,19 @@ arguments exeName = Arguments <> value 0 <> showDefault ) + <*> switch (long "project-ghc-version" + <> help "Work out the project GHC version and print it") -- --------------------------------------------------------------------- --- Set the GHC libdir to the nix libdir if it's present. -getLibdir :: IO FilePath -getLibdir = fromMaybe GHC.Paths.libdir <$> lookupEnv "NIX_GHC_LIBDIR" -ghcideVersion :: IO String -ghcideVersion = do +haskellLanguageServerVersion :: IO String +haskellLanguageServerVersion = do path <- getExecutablePath let gitHashSection = case $(gitHash) of x | x == "UNKNOWN" -> "" x -> " (GIT hash: " <> x <> ")" - return $ "ghcide version: " <> showVersion version + return $ "haskell-language-server version: " <> showVersion version <> " (GHC: " <> VERSION_ghc <> ") (PATH: " <> path <> ")" <> gitHashSection --- --------------------------------------------------------------------- diff --git a/exe/Main.hs b/exe/Main.hs index 0e4d299900..54e2354e8e 100644 --- a/exe/Main.hs +++ b/exe/Main.hs @@ -16,33 +16,15 @@ module Main(main) where import Arguments -import Control.Concurrent.Async import Control.Concurrent.Extra --- import Control.Exception -import Control.Exception.Safe import Control.Monad.Extra -import Control.Monad.IO.Class -import qualified Crypto.Hash.SHA1 as H -import Data.Aeson (ToJSON(toJSON)) -import Data.Bifunctor (Bifunctor(second)) -import Data.ByteString.Base16 (encode) -import qualified Data.ByteString.Char8 as B import Data.Default -import Data.Either -import Data.Either.Extra -import Data.Foldable -import Data.Function -import qualified Data.HashMap.Strict as HM import qualified Data.HashSet as HashSet -import Data.IORef import Data.List.Extra import qualified Data.Map.Strict as Map import Data.Maybe import qualified Data.Text as T import qualified Data.Text.IO as T -import Data.Time.Clock (UTCTime) -import Data.Version --- import Development.GitRev import Development.IDE.Core.Debouncer import Development.IDE.Core.FileStore import Development.IDE.Core.OfInterest @@ -50,25 +32,15 @@ import Development.IDE.Core.RuleTypes import Development.IDE.Core.Rules import Development.IDE.Core.Service import Development.IDE.Core.Shake -import Development.IDE.GHC.Util import Development.IDE.LSP.LanguageServer import Development.IDE.LSP.Protocol import Development.IDE.Plugin +import Development.IDE.Session import Development.IDE.Types.Diagnostics import Development.IDE.Types.Location import Development.IDE.Types.Logger import Development.IDE.Types.Options -import Development.Shake (Action) -import DynFlags (gopt_set, gopt_unset, - updOptLevel) -import DynFlags (PackageFlag(..), PackageArg(..)) -import GHC hiding (def) -import GHC.Check --- import GhcMonad import HIE.Bios.Cradle -import HIE.Bios.Environment (addCmdOpts, makeDynFlagsAbsolute) -import HIE.Bios.Types -import HscTypes (HscEnv(..), ic_dflags) import qualified Language.Haskell.LSP.Core as LSP import Ide.Logger import Ide.Plugin @@ -76,14 +48,7 @@ import Ide.Plugin.Config import Ide.Types (IdePlugins, ipMap) import Language.Haskell.LSP.Messages import Language.Haskell.LSP.Types -import Linker (initDynLinker) -import Module -import NameCache -import Packages --- import Paths_ghcide -import System.Directory import qualified System.Directory.Extra as IO --- import System.Environment import System.Exit import System.FilePath import System.IO @@ -108,7 +73,6 @@ import Ide.Plugin.StylishHaskell as StylishHaskell import Ide.Plugin.Brittany as Brittany #endif import Ide.Plugin.Pragmas as Pragmas --- import Data.Typeable (Typeable) -- --------------------------------------------------------------------- @@ -157,18 +121,15 @@ ghcIdePlugins pid ps = (asGhcIdePlugin ps, allLspCmdIds' pid ps) -- --------------------------------------------------------------------- --- -- Set the GHC libdir to the nix libdir if it's present. --- getLibdir :: IO FilePath --- getLibdir = fromMaybe GHC.Paths.libdir <$> lookupEnv "NIX_GHC_LIBDIR" - main :: IO () main = do -- WARNING: If you write to stdout before runLanguageServer -- then the language server will not work args@Arguments{..} <- getArguments "haskell-language-server" - if argsVersion then ghcideVersion >>= putStrLn >> exitSuccess - else hPutStrLn stderr {- see WARNING above -} =<< ghcideVersion + hlsVer <- haskellLanguageServerVersion + if argsVersion then putStrLn hlsVer + else hPutStrLn stderr hlsVer {- see WARNING above -} LSP.setupLogger argsLogFile ["hls", "hie-bios"] $ if argsDebugOn then L.DEBUG else L.INFO @@ -198,6 +159,7 @@ main = do hPutStrLn stderr "Starting (haskell-language-server)LSP server..." hPutStrLn stderr $ " with arguments: " <> show args hPutStrLn stderr $ " with plugins: " <> show (Map.keys $ ipMap idePlugins') + hPutStrLn stderr $ " in directory: " <> dir hPutStrLn stderr "If you are seeing this in a terminal, you probably should have run ghcide WITHOUT the --lsp option!" runLanguageServer options (pluginHandler plugins) getInitialConfig getConfigFromNotification $ \getLspId event vfs caps wProg wIndefProg -> do t <- t @@ -267,570 +229,3 @@ showEvent _ (EventFileDiagnostics _ []) = return () showEvent lock (EventFileDiagnostics (toNormalizedFilePath' -> file) diags) = withLock lock $ T.putStrLn $ showDiagnosticsColored $ map (file,ShowDiag,) diags showEvent lock e = withLock lock $ print e - - --- | Run the specific cradle on a specific FilePath via hie-bios. -cradleToSessionOpts :: Cradle a -> FilePath -> IO (Either [CradleError] ComponentOptions) -cradleToSessionOpts cradle file = do - let showLine s = putStrLn ("> " ++ s) - cradleRes <- runCradle (cradleOptsProg cradle) showLine file - case cradleRes of - CradleSuccess r -> pure (Right r) - CradleFail err -> return (Left [err]) - -- For the None cradle perhaps we still want to report an Info - -- message about the fact that the file is being ignored. - CradleNone -> return (Left []) - -emptyHscEnv :: IORef NameCache -> IO HscEnv -emptyHscEnv nc = do - libdir <- getLibdir - env <- runGhc (Just libdir) getSession - initDynLinker env - pure $ setNameCache nc env - --- | Convert a target to a list of potential absolute paths. --- A TargetModule can be anywhere listed by the supplied include --- directories --- A target file is a relative path but with a specific prefix so just need --- to canonicalise it. -targetToFile :: [FilePath] -> TargetId -> IO [NormalizedFilePath] -targetToFile is (TargetModule mod) = do - let fps = [i moduleNameSlashes mod -<.> ext | ext <- exts, i <- is ] - exts = ["hs", "hs-boot", "lhs"] - mapM (fmap toNormalizedFilePath' . canonicalizePath) fps -targetToFile _ (TargetFile f _) = do - f' <- canonicalizePath f - return [toNormalizedFilePath' f'] - -setNameCache :: IORef NameCache -> HscEnv -> HscEnv -setNameCache nc hsc = hsc { hsc_NC = nc } - --- | This is the key function which implements multi-component support. All --- components mapping to the same hie.yaml file are mapped to the same --- HscEnv which is updated as new components are discovered. -loadSession :: FilePath -> IO (Action IdeGhcSession) -loadSession dir = do - -- Mapping from hie.yaml file to HscEnv, one per hie.yaml file - hscEnvs <- newVar Map.empty :: IO (Var HieMap) - -- Mapping from a Filepath to HscEnv - fileToFlags <- newVar Map.empty :: IO (Var FlagsMap) - -- Version of the mappings above - version <- newVar 0 - let returnWithVersion fun = IdeGhcSession fun <$> liftIO (readVar version) - let invalidateShakeCache = do - modifyVar_ version (return . succ) - -- This caches the mapping from Mod.hs -> hie.yaml - cradleLoc <- liftIO $ memoIO $ \v -> do - res <- findCradle v - -- Sometimes we get C:, sometimes we get c:, and sometimes we get a relative path - -- try and normalise that - -- e.g. see https://github.com/digital-asset/ghcide/issues/126 - res' <- traverse IO.makeAbsolute res - return $ normalise <$> res' - - libdir <- getLibdir - installationCheck <- ghcVersionChecker libdir - - dummyAs <- async $ return (error "Uninitialised") - runningCradle <- newVar dummyAs :: IO (Var (Async (IdeResult HscEnvEq,[FilePath]))) - - case installationCheck of - InstallationNotFound{..} -> - error $ "GHC installation not found in libdir: " <> libdir - InstallationMismatch{..} -> - return $ returnWithVersion $ \fp -> return (([renderPackageSetupException compileTime fp GhcVersionMismatch{..}], Nothing),[]) - InstallationChecked compileTime ghcLibCheck -> return $ do - ShakeExtras{logger, eventer, withIndefiniteProgress, ideNc, session=ideSession} <- getShakeExtras - IdeOptions{optTesting = IdeTesting optTesting} <- getIdeOptions - - -- Create a new HscEnv from a hieYaml root and a set of options - -- If the hieYaml file already has an HscEnv, the new component is - -- combined with the components in the old HscEnv into a new HscEnv - -- which contains the union. - let packageSetup :: (Maybe FilePath, NormalizedFilePath, ComponentOptions) - -> IO (HscEnv, ComponentInfo, [ComponentInfo]) - packageSetup (hieYaml, cfp, opts) = do - -- Parse DynFlags for the newly discovered component - hscEnv <- emptyHscEnv ideNc - (df, targets) <- evalGhcEnv hscEnv $ - setOptions opts (hsc_dflags hscEnv) - let deps = componentDependencies opts ++ maybeToList hieYaml - dep_info <- getDependencyInfo deps - -- Now lookup to see whether we are combining with an existing HscEnv - -- or making a new one. The lookup returns the HscEnv and a list of - -- information about other components loaded into the HscEnv - -- (unitId, DynFlag, Targets) - modifyVar hscEnvs $ \m -> do - -- Just deps if there's already an HscEnv - -- Nothing is it's the first time we are making an HscEnv - let oldDeps = Map.lookup hieYaml m - let -- Add the raw information about this component to the list - -- We will modify the unitId and DynFlags used for - -- compilation but these are the true source of - -- information. - new_deps = RawComponentInfo (thisInstalledUnitId df) df targets cfp opts dep_info - : maybe [] snd oldDeps - -- Get all the unit-ids for things in this component - inplace = map rawComponentUnitId new_deps - - new_deps' <- forM new_deps $ \RawComponentInfo{..} -> do - -- Remove all inplace dependencies from package flags for - -- components in this HscEnv - let (df2, uids) = removeInplacePackages inplace rawComponentDynFlags - let prefix = show rawComponentUnitId - -- See Note [Avoiding bad interface files] - processed_df <- setCacheDir logger prefix (sort $ map show uids) opts df2 - -- The final component information, mostly the same but the DynFlags don't - -- contain any packages which are also loaded - -- into the same component. - pure $ ComponentInfo rawComponentUnitId - processed_df - uids - rawComponentTargets - rawComponentFP - rawComponentCOptions - rawComponentDependencyInfo - -- Make a new HscEnv, we have to recompile everything from - -- scratch again (for now) - -- It's important to keep the same NameCache though for reasons - -- that I do not fully understand - logInfo logger (T.pack ("Making new HscEnv" ++ show inplace)) - hscEnv <- emptyHscEnv ideNc - newHscEnv <- - -- Add the options for the current component to the HscEnv - evalGhcEnv hscEnv $ do - _ <- setSessionDynFlags df - checkSession logger ghcLibCheck - getSession - - -- Modify the map so the hieYaml now maps to the newly created - -- HscEnv - -- Returns - -- . the new HscEnv so it can be used to modify the - -- FilePath -> HscEnv map (fileToFlags) - -- . The information for the new component which caused this cache miss - -- . The modified information (without -inplace flags) for - -- existing packages - pure (Map.insert hieYaml (newHscEnv, new_deps) m, (newHscEnv, head new_deps', tail new_deps')) - - let session :: (Maybe FilePath, NormalizedFilePath, ComponentOptions) -> IO ([NormalizedFilePath],(IdeResult HscEnvEq,[FilePath])) - session (hieYaml, cfp, opts) = do - (hscEnv, new, old_deps) <- packageSetup (hieYaml, cfp, opts) - -- Make a map from unit-id to DynFlags, this is used when trying to - -- resolve imports. (especially PackageImports) - let uids = map (\ci -> (componentUnitId ci, componentDynFlags ci)) (new : old_deps) - - -- For each component, now make a new HscEnvEq which contains the - -- HscEnv for the hie.yaml file but the DynFlags for that component - - -- New HscEnv for the component in question, returns the new HscEnvEq and - -- a mapping from FilePath to the newly created HscEnvEq. - let new_cache = newComponentCache logger hscEnv uids - (cs, res) <- new_cache new - -- Modified cache targets for everything else in the hie.yaml file - -- which now uses the same EPS and so on - cached_targets <- concatMapM (fmap fst . new_cache) old_deps - modifyVar_ fileToFlags $ \var -> do - pure $ Map.insert hieYaml (HM.fromList (cs ++ cached_targets)) var - - -- Invalidate all the existing GhcSession build nodes by restarting the Shake session - invalidateShakeCache - -- restartShakeSession [kick] - - return (map fst cs, second Map.keys res) - - let consultCradle :: Maybe FilePath -> FilePath -> IO ([NormalizedFilePath], (IdeResult HscEnvEq, [FilePath])) - consultCradle hieYaml cfp = do - when optTesting $ eventer $ notifyCradleLoaded cfp - logInfo logger $ T.pack ("Consulting the cradle for " <> show cfp) - - cradle <- maybe (loadImplicitCradle $ addTrailingPathSeparator dir) loadCradle hieYaml - -- Display a user friendly progress message here: They probably don't know what a - -- cradle is - let progMsg = "Setting up project " <> T.pack (takeBaseName (cradleRootDir cradle)) - eopts <- withIndefiniteProgress progMsg LSP.NotCancellable $ - cradleToSessionOpts cradle cfp - - logDebug logger $ T.pack ("Session loading result: " <> show eopts) - case eopts of - -- The cradle gave us some options so get to work turning them - -- into and HscEnv. - Right opts -> do - session (hieYaml, toNormalizedFilePath' cfp, opts) - -- Failure case, either a cradle error or the none cradle - Left err -> do - dep_info <- getDependencyInfo (maybeToList hieYaml) - let ncfp = toNormalizedFilePath' cfp - let res = (map (renderCradleError ncfp) err, Nothing) - modifyVar_ fileToFlags $ \var -> do - pure $ Map.insertWith HM.union hieYaml (HM.singleton ncfp (res, dep_info)) var - return ([ncfp],(res,[])) - - -- This caches the mapping from hie.yaml + Mod.hs -> [String] - -- Returns the Ghc session and the cradle dependencies - let sessionOpts :: (Maybe FilePath, FilePath) -> IO ([NormalizedFilePath], (IdeResult HscEnvEq, [FilePath])) - sessionOpts (hieYaml, file) = do - v <- fromMaybe HM.empty . Map.lookup hieYaml <$> readVar fileToFlags - cfp <- canonicalizePath file - case HM.lookup (toNormalizedFilePath' cfp) v of - Just (opts, old_di) -> do - deps_ok <- checkDependencyInfo old_di - if not deps_ok - then do - -- If the dependencies are out of date then clear both caches and start - -- again. - modifyVar_ fileToFlags (const (return Map.empty)) - -- Keep the same name cache - modifyVar_ hscEnvs (return . Map.adjust (\(h, _) -> (h, [])) hieYaml ) - consultCradle hieYaml cfp - else return ([], (opts, Map.keys old_di)) - Nothing -> consultCradle hieYaml cfp - - -- The main function which gets options for a file. We only want one of these running - -- at a time. Therefore the IORef contains the currently running cradle, if we try - -- to get some more options then we wait for the currently running action to finish - -- before attempting to do so. - let getOptions :: FilePath -> IO ([NormalizedFilePath],(IdeResult HscEnvEq, [FilePath])) - getOptions file = do - hieYaml <- cradleLoc file - sessionOpts (hieYaml, file) `catch` \e -> - return ([],(([renderPackageSetupException compileTime file e], Nothing),[])) - - returnWithVersion $ \file -> do - (cs, opts) <- liftIO $ join $ mask_ $ modifyVar runningCradle $ \as -> do - -- If the cradle is not finished, then wait for it to finish. - void $ wait as - as <- async $ getOptions file - return $ (fmap snd as, wait as) - unless (null cs) $ - void $ shakeEnqueueSession ideSession $ mkDelayedAction "InitialLoad" Info $ void $ do - cfps' <- liftIO $ filterM (IO.doesFileExist . fromNormalizedFilePath) cs - mmt <- uses GetModificationTime cfps' - let cs_exist = catMaybes (zipWith (<$) cfps' mmt) - uses GetModIface cs_exist - pure opts - --- | Create a mapping from FilePaths to HscEnvEqs -newComponentCache - :: Logger - -> HscEnv - -> [(InstalledUnitId, DynFlags)] - -> ComponentInfo - -> IO ([(NormalizedFilePath, (IdeResult HscEnvEq, DependencyInfo))], (IdeResult HscEnvEq, DependencyInfo)) -newComponentCache logger hsc_env uids ci = do - let df = componentDynFlags ci - let hscEnv' = hsc_env { hsc_dflags = df - , hsc_IC = (hsc_IC hsc_env) { ic_dflags = df } } - - henv <- newHscEnvEq hscEnv' uids - let res = (([], Just henv), componentDependencyInfo ci) - logDebug logger ("New Component Cache HscEnvEq: " <> T.pack (show res)) - - let is = importPaths df - ctargets <- concatMapM (targetToFile is . targetId) (componentTargets ci) - -- A special target for the file which caused this wonderful - -- component to be created. In case the cradle doesn't list all the targets for - -- the component, in which case things will be horribly broken anyway. - -- Otherwise, we will immediately attempt to reload this module which - -- causes an infinite loop and high CPU usage. - let special_target = (componentFP ci, res) - let xs = map (,res) ctargets - return (special_target:xs, res) - -{- Note [Avoiding bad interface files] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Originally, we set the cache directory for the various components once -on the first occurrence of the component. -This works fine if these components have no references to each other, -but you have components that depend on each other, the interface files are -updated for each component. -After restarting the session and only opening the component that depended -on the other, suddenly the interface files of this component are stale. -However, from the point of view of `ghcide`, they do not look stale, -thus, not regenerated and the IDE shows weird errors such as: -``` -typecheckIface -Declaration for Rep_ClientRunFlags -Axiom branches Rep_ClientRunFlags: - Failed to load interface for ‘Distribution.Simple.Flag’ - Use -v to see a list of the files searched for. -``` -and -``` -expectJust checkFamInstConsistency -CallStack (from HasCallStack): - error, called at compiler\\utils\\Maybes.hs:55:27 in ghc:Maybes - expectJust, called at compiler\\typecheck\\FamInst.hs:461:30 in ghc:FamInst -``` - -To mitigate this, we set the cache directory for each component dependent -on the components of the current `HscEnv`, additionally to the component options -of the respective components. -Assume two components, c1, c2, where c2 depends on c1, and the options of the -respective components are co1, co2. -If we want to load component c2, followed by c1, we set the cache directory for -each component in this way: - - * Load component c2 - * (Cache Directory State) - - name of c2 + co2 - * Load component c1 - * (Cache Directory State) - - name of c2 + name of c1 + co2 - - name of c2 + name of c1 + co1 - -Overall, we created three cache directories. If we opened c1 first, then we -create a fourth cache directory. -This makes sure that interface files are always correctly updated. - -Since this causes a lot of recompilation, we only update the cache-directory, -if the dependencies of a component have really changed. -E.g. when you load two executables, they can not depend on each other. They -should be filtered out, such that we dont have to re-compile everything. --} - --- | Set the cache-directory based on the ComponentOptions and a list of --- internal packages. --- For the exact reason, see Note [Avoiding bad interface files]. -setCacheDir :: MonadIO m => Logger -> String -> [String] -> ComponentOptions -> DynFlags -> m DynFlags -setCacheDir logger prefix hscComponents comps dflags = do - cacheDir <- liftIO $ getCacheDir prefix (hscComponents ++ componentOptions comps) - liftIO $ logInfo logger $ "Using interface files cache dir: " <> T.pack cacheDir - pure $ dflags - & setHiDir cacheDir - & setHieDir cacheDir - - -renderCradleError :: NormalizedFilePath -> CradleError -> FileDiagnostic -renderCradleError nfp (CradleError _ _ec t) = - ideErrorWithSource (Just "cradle") (Just DsError) nfp (T.unlines (map T.pack t)) - --- See Note [Multi Cradle Dependency Info] -type DependencyInfo = Map.Map FilePath (Maybe UTCTime) -type HieMap = Map.Map (Maybe FilePath) (HscEnv, [RawComponentInfo]) -type FlagsMap = Map.Map (Maybe FilePath) (HM.HashMap NormalizedFilePath (IdeResult HscEnvEq, DependencyInfo)) - --- This is pristine information about a component -data RawComponentInfo = RawComponentInfo - { rawComponentUnitId :: InstalledUnitId - -- | Unprocessed DynFlags. Contains inplace packages such as libraries. - -- We do not want to use them unprocessed. - , rawComponentDynFlags :: DynFlags - -- | All targets of this components. - , rawComponentTargets :: [Target] - -- | Filepath which caused the creation of this component - , rawComponentFP :: NormalizedFilePath - -- | Component Options used to load the component. - , rawComponentCOptions :: ComponentOptions - -- | Maps cradle dependencies, such as `stack.yaml`, or `.cabal` file - -- to last modification time. See Note [Multi Cradle Dependency Info]. - , rawComponentDependencyInfo :: DependencyInfo - } - --- This is processed information about the component, in particular the dynflags will be modified. -data ComponentInfo = ComponentInfo - { componentUnitId :: InstalledUnitId - -- | Processed DynFlags. Does not contain inplace packages such as local - -- libraries. Can be used to actually load this Component. - , componentDynFlags :: DynFlags - -- | Internal units, such as local libraries, that this component - -- is loaded with. These have been extracted from the original - -- ComponentOptions. - , componentInternalUnits :: [InstalledUnitId] - -- | All targets of this components. - , componentTargets :: [Target] - -- | Filepath which caused the creation of this component - , componentFP :: NormalizedFilePath - -- | Component Options used to load the component. - , componentCOptions :: ComponentOptions - -- | Maps cradle dependencies, such as `stack.yaml`, or `.cabal` file - -- to last modification time. See Note [Multi Cradle Dependency Info] - , componentDependencyInfo :: DependencyInfo - } - --- | Check if any dependency has been modified lately. -checkDependencyInfo :: DependencyInfo -> IO Bool -checkDependencyInfo old_di = do - di <- getDependencyInfo (Map.keys old_di) - return (di == old_di) - --- Note [Multi Cradle Dependency Info] --- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ --- Why do we implement our own file modification tracking here? --- The primary reason is that the custom caching logic is quite complicated and going into shake --- adds even more complexity and more indirection. I did try for about 5 hours to work out how to --- use shake rules rather than IO but eventually gave up. - --- | Computes a mapping from a filepath to its latest modification date. --- See Note [Multi Cradle Dependency Info] why we do this ourselves instead --- of letting shake take care of it. -getDependencyInfo :: [FilePath] -> IO DependencyInfo -getDependencyInfo fs = Map.fromList <$> mapM do_one fs - - where - tryIO :: IO a -> IO (Either IOException a) - tryIO = try - - do_one :: FilePath -> IO (FilePath, Maybe UTCTime) - do_one fp = (fp,) . eitherToMaybe <$> tryIO (getModificationTime fp) - --- | This function removes all the -package flags which refer to packages we --- are going to deal with ourselves. For example, if a executable depends --- on a library component, then this function will remove the library flag --- from the package flags for the executable --- --- There are several places in GHC (for example the call to hptInstances in --- tcRnImports) which assume that all modules in the HPT have the same unit --- ID. Therefore we create a fake one and give them all the same unit id. -removeInplacePackages :: [InstalledUnitId] -> DynFlags -> (DynFlags, [InstalledUnitId]) -removeInplacePackages us df = (df { packageFlags = ps - , thisInstalledUnitId = fake_uid }, uids) - where - (uids, ps) = partitionEithers (map go (packageFlags df)) - fake_uid = toInstalledUnitId (stringToUnitId "fake_uid") - go p@(ExposePackage _ (UnitIdArg u) _) = if toInstalledUnitId u `elem` us - then Left (toInstalledUnitId u) - else Right p - go p = Right p - --- | Memoize an IO function, with the characteristics: --- --- * If multiple people ask for a result simultaneously, make sure you only compute it once. --- --- * If there are exceptions, repeatedly reraise them. --- --- * If the caller is aborted (async exception) finish computing it anyway. -memoIO :: Ord a => (a -> IO b) -> IO (a -> IO b) -memoIO op = do - ref <- newVar Map.empty - return $ \k -> join $ mask_ $ modifyVar ref $ \mp -> - case Map.lookup k mp of - Nothing -> do - res <- onceFork $ op k - return (Map.insert k res mp, res) - Just res -> return (mp, res) - --- | Throws if package flags are unsatisfiable -setOptions :: GhcMonad m => ComponentOptions -> DynFlags -> m (DynFlags, [Target]) -setOptions (ComponentOptions theOpts compRoot _) dflags = do - (dflags', targets) <- addCmdOpts theOpts dflags - let dflags'' = - -- disabled, generated directly by ghcide instead - flip gopt_unset Opt_WriteInterface $ - -- disabled, generated directly by ghcide instead - -- also, it can confuse the interface stale check - dontWriteHieFiles $ - setIgnoreInterfacePragmas $ - setLinkerOptions $ - disableOptimisation $ - makeDynFlagsAbsolute compRoot dflags' - -- initPackages parses the -package flags and - -- sets up the visibility for each component. - -- Throws if a -package flag cannot be satisfied. - (final_df, _) <- liftIO $ wrapPackageSetupException $ initPackages dflags'' - return (final_df, targets) - - --- we don't want to generate object code so we compile to bytecode --- (HscInterpreted) which implies LinkInMemory --- HscInterpreted -setLinkerOptions :: DynFlags -> DynFlags -setLinkerOptions df = df { - ghcLink = LinkInMemory - , hscTarget = HscNothing - , ghcMode = CompManager - } - -setIgnoreInterfacePragmas :: DynFlags -> DynFlags -setIgnoreInterfacePragmas df = - gopt_set (gopt_set df Opt_IgnoreInterfacePragmas) Opt_IgnoreOptimChanges - -disableOptimisation :: DynFlags -> DynFlags -disableOptimisation df = updOptLevel 0 df - -setHiDir :: FilePath -> DynFlags -> DynFlags -setHiDir f d = - -- override user settings to avoid conflicts leading to recompilation - d { hiDir = Just f} - -getCacheDir :: String -> [String] -> IO FilePath -getCacheDir prefix opts = IO.getXdgDirectory IO.XdgCache (cacheDir prefix ++ "-" ++ opts_hash) - where - -- Create a unique folder per set of different GHC options, assuming that each different set of - -- GHC options will create incompatible interface files. - opts_hash = B.unpack $ encode $ H.finalize $ H.updates H.init (map B.pack opts) - --- | Sub directory for the cache path -cacheDir :: String -cacheDir = "ghcide" - -notifyCradleLoaded :: FilePath -> FromServerMessage -notifyCradleLoaded fp = - NotCustomServer $ - NotificationMessage "2.0" (CustomServerMethod cradleLoadedMethod) $ - toJSON fp - -cradleLoadedMethod :: T.Text -cradleLoadedMethod = "ghcide/cradle/loaded" - ----------------------------------------------------------------------------------------------------- - -ghcVersionChecker :: GhcVersionChecker -ghcVersionChecker = $$(makeGhcVersionChecker getLibdir) - --- | Throws a 'PackageSetupException' if the 'Session' cannot be used by ghcide -checkSession :: Logger -> Ghc PackageCheckResult -> Ghc () -checkSession logger ghcLibCheck = - ghcLibCheck >>= \res -> case guessCompatibility res of - ProbablyCompatible mbWarning -> - for_ mbWarning $ liftIO . logInfo logger . T.pack - NotCompatible err -> - liftIO $ throwIO $ PackageCheckFailed err - -data PackageSetupException - = PackageSetupException - { message :: !String - } - | GhcVersionMismatch - { compileTime :: !Version - , runTime :: !Version - } - | PackageCheckFailed !NotCompatibleReason - deriving (Eq, Show, Typeable) - -instance Exception PackageSetupException - --- | Wrap any exception as a 'PackageSetupException' -wrapPackageSetupException :: IO a -> IO a -wrapPackageSetupException = handleAny $ \case - e | Just (pkgE :: PackageSetupException) <- fromException e -> throwIO pkgE - e -> (throwIO . PackageSetupException . show) e - -showPackageSetupException :: Version -> PackageSetupException -> String -showPackageSetupException _ GhcVersionMismatch{..} = unwords - ["ghcide compiled against GHC" - ,showVersion compileTime - ,"but currently using" - ,showVersion runTime - ,"\nThis is unsupported, ghcide must be compiled with the same GHC version as the project." - ] -showPackageSetupException compileTime PackageSetupException{..} = unwords - [ "ghcide compiled by GHC", showVersion compileTime - , "failed to load packages:", message <> "." - , "\nPlease ensure that ghcide is compiled with the same GHC installation as the project."] -showPackageSetupException _ (PackageCheckFailed PackageVersionMismatch{..}) = unwords - ["ghcide compiled with package " - , packageName <> "-" <> showVersion compileTime - ,"but project uses package" - , packageName <> "-" <> showVersion runTime - ,"\nThis is unsupported, ghcide must be compiled with the same GHC installation as the project." - ] -showPackageSetupException _ (PackageCheckFailed BasePackageAbiMismatch{..}) = unwords - ["ghcide compiled with base-" <> showVersion compileTime <> "-" <> compileTimeAbi - ,"but project uses base-" <> showVersion compileTime <> "-" <> runTimeAbi - ,"\nThis is unsupported, ghcide must be compiled with the same GHC installation as the project." - ] - -renderPackageSetupException :: Version -> FilePath -> PackageSetupException -> (NormalizedFilePath, ShowDiagnostic, Diagnostic) -renderPackageSetupException compileTime fp e = - ideErrorWithSource (Just "cradle") (Just DsError) (toNormalizedFilePath' fp) (T.pack $ showPackageSetupException compileTime e) diff --git a/exe/Wrapper.hs b/exe/Wrapper.hs index 395eae6972..703ceedaf3 100644 --- a/exe/Wrapper.hs +++ b/exe/Wrapper.hs @@ -1,33 +1,24 @@ -{-# LANGUAGE CPP #-} {-# LANGUAGE RecordWildCards #-} -- | This module is based on the hie-wrapper.sh script in -- https://github.com/alanz/vscode-hie-server module Main where -#if __GLASGOW_HASKELL__ < 804 -import Data.Semigroup -#endif - import Arguments --- import Control.Concurrent.Extra import Control.Monad.Extra -import Data.Foldable -import Data.List --- import Data.List.Extra --- import qualified Data.Text as T --- import qualified Data.Text.IO as T --- import Development.IDE.Types.Logger +import Data.Foldable +import Data.List +import Data.Void import HIE.Bios -import Ide.Cradle (findLocalCradle) -import Ide.Logger (logm) -import Ide.Version -import System.Directory -import System.Environment +import HIE.Bios.Environment +import HIE.Bios.Types +import Ide.Version +import System.Directory +import System.Environment import System.Exit -import System.FilePath +import System.FilePath import System.IO -import System.Info -import System.Process +import System.Info +import System.Process -- --------------------------------------------------------------------- @@ -37,41 +28,31 @@ main = do -- then the language server will not work Arguments{..} <- getArguments "haskell-language-server-wrapper" - if argsVersion then ghcideVersion >>= putStrLn >> exitSuccess - else hPutStrLn stderr {- see WARNING above -} =<< ghcideVersion - - -- lock to avoid overlapping output on stdout - -- lock <- newLock - -- let logger p = Logger $ \pri msg -> when (pri >= p) $ withLock lock $ - -- T.putStrLn $ T.pack ("[" ++ upper (show pri) ++ "] ") <> msg - - whenJust argsCwd setCurrentDirectory + d <- getCurrentDirectory - -- let mLogFileName = optLogFile opts + -- Get the cabal directory from the cradle + cradle <- findLocalCradle (d "a") + setCurrentDirectory $ cradleRootDir cradle - -- logLevel = if optDebugOn opts - -- then L.DEBUG - -- else L.INFO + when argsProjectGhcVersion $ getRuntimeGhcVersion' cradle >>= putStrLn >> exitSuccess + when argsVersion $ haskellLanguageServerVersion >>= putStrLn >> exitSuccess - -- Core.setupLogger mLogFileName ["hie"] logLevel + whenJust argsCwd setCurrentDirectory progName <- getProgName - logm $ "run entered for haskell-language-server-wrapper(" ++ progName ++ ") " - ++ hlsVersion - d <- getCurrentDirectory - logm $ "Current directory:" ++ d - logm $ "Operating system:" ++ os + hPutStrLn stderr $ "Run entered for haskell-language-server-wrapper(" ++ progName ++ ") " + ++ hlsVersion + hPutStrLn stderr $ "Current directory: " ++ d + hPutStrLn stderr $ "Operating system: " ++ os args <- getArgs - logm $ "args:" ++ show args - - -- Get the cabal directory from the cradle - cradle <- findLocalCradle (d "File.hs") - let dir = cradleRootDir cradle - logm $ "Cradle directory:" ++ dir - setCurrentDirectory dir + hPutStrLn stderr $ "Arguments: " ++ show args + hPutStrLn stderr $ "Cradle directory: " ++ cradleRootDir cradle + hPutStrLn stderr $ "Cradle type: " ++ show (actionName (cradleOptsProg cradle)) - ghcVersion <- getProjectGhcVersion cradle - logm $ "Project GHC version:" ++ ghcVersion + -- Get the ghc version -- this might fail! + hPutStrLn stderr $ "Consulting the cradle to get project GHC version..." + ghcVersion <- getRuntimeGhcVersion' cradle + hPutStrLn stderr $ "Project GHC version: " ++ ghcVersion let hlsBin = "haskell-language-server-" ++ ghcVersion @@ -82,17 +63,62 @@ main = do candidates' = [hlsBin, backupHlsBin, "haskell-language-server"] candidates = map (++ exeExtension) candidates' - logm $ "haskell-language-server exe candidates :" ++ show candidates + hPutStrLn stderr $ "haskell-language-server exe candidates: " ++ show candidates mexes <- traverse findExecutable candidates case asum mexes of - Nothing -> logm $ "cannot find any haskell-language-server exe, looked for:" ++ intercalate ", " candidates + Nothing -> hPutStrLn stderr $ "Cannot find any haskell-language-server exe, looked for: " ++ intercalate ", " candidates Just e -> do - logm $ "found haskell-language-server exe at:" ++ e - logm $ "args:" ++ show args - logm "launching ....\n\n\n" + hPutStrLn stderr $ "Launching haskell-language-server exe at:" ++ e callProcess e args - logm "done" --- --------------------------------------------------------------------- +-- | Version of 'getRuntimeGhcVersion' that dies if we can't get it, and also +-- checks to see if the tool is missing if it is one of +getRuntimeGhcVersion' :: Show a => Cradle a -> IO String +getRuntimeGhcVersion' cradle = do + + -- See if the tool is installed + case actionName (cradleOptsProg cradle) of + Stack -> checkToolExists "stack" + Cabal -> checkToolExists "cabal" + Default -> checkToolExists "ghc" + Direct -> checkToolExists "ghc" + _ -> pure () + + ghcVersionRes <- getRuntimeGhcVersion cradle + case ghcVersionRes of + CradleSuccess ver -> do + return ver + CradleFail error -> die $ "Failed to get project GHC version:" ++ show error + CradleNone -> die "Failed get project GHC version, since we have a none cradle" + where + checkToolExists exe = do + exists <- findExecutable exe + case exists of + Just _ -> pure () + Nothing -> + die $ "Cradle requires " ++ exe ++ " but couldn't find it" ++ "\n" + ++ show cradle + +-- | Find the cradle that the given File belongs to. +-- +-- First looks for a "hie.yaml" file in the directory of the file +-- or one of its parents. If this file is found, the cradle +-- is read from the config. If this config does not comply to the "hie.yaml" +-- specification, an error is raised. +-- +-- If no "hie.yaml" can be found, the implicit config is used. +-- The implicit config uses different heuristics to determine the type +-- of the project that may or may not be accurate. +findLocalCradle :: FilePath -> IO (Cradle Void) +findLocalCradle fp = do + cradleConf <- findCradle fp + crdl <- case cradleConf of + Just yaml -> do + hPutStrLn stderr $ "Found \"" ++ yaml ++ "\" for \"" ++ fp ++ "\"" + loadCradle yaml + Nothing -> loadImplicitCradle fp + hPutStrLn stderr $ "Module \"" ++ fp ++ "\" is loaded by Cradle: " ++ show crdl + return crdl + diff --git a/ghcide b/ghcide index 8530b98087..7e895cfa53 160000 --- a/ghcide +++ b/ghcide @@ -1 +1 @@ -Subproject commit 8530b980871f9bc4f6fc2e688a4620e5fe1a0340 +Subproject commit 7e895cfa53260b41996df707baec496a8f2c75dc diff --git a/haskell-language-server.cabal b/haskell-language-server.cabal index d4095fa735..48366782de 100644 --- a/haskell-language-server.cabal +++ b/haskell-language-server.cabal @@ -38,7 +38,6 @@ common agpl library import: agpl exposed-modules: - Ide.Cradle Ide.Logger Ide.Plugin Ide.Plugin.Config @@ -63,7 +62,6 @@ library , aeson , binary , bytestring - , cabal-helper >= 1.1 , containers , data-default , deepseq @@ -136,33 +134,20 @@ executable haskell-language-server build-depends: base >=4.7 && <5 - , aeson - , async - , base16-bytestring , binary - , bytestring - , cryptohash-sha1 , containers , data-default - , deepseq , directory , extra , filepath - -------------------------------------------------------------- - -- The MIN_GHC_API_VERSION macro relies on MIN_VERSION pragmas - -- which require depending on ghc. So the tests need to depend - -- on ghc if they need to use MIN_GHC_API_VERSION. Maybe a - -- better solution can be found, but this is a quick solution - -- which works for now. + , process , ghc -------------------------------------------------------------- - , ghc-check >= 0.5.0.1 && < 0.6 - , ghc-paths , ghcide , gitrev , hashable , haskell-lsp - , hie-bios >= 0.4 + , hie-bios , haskell-language-server , hslogger , optparse-applicative @@ -233,7 +218,9 @@ common hls-test-utils , lsp-test , stm , tasty-hunit + , temporary , text + , transformers , unordered-containers , yaml ghc-options: -Wall -Wredundant-constraints @@ -291,3 +278,18 @@ test-suite func-test -threaded -rtsopts -with-rtsopts=-N if flag(pedantic) ghc-options: -Werror -Wredundant-constraints + +test-suite wrapper-test + import: agpl, hls-test-utils + type: exitcode-stdio-1.0 + build-tool-depends: haskell-language-server:haskell-language-server-wrapper + default-language: Haskell2010 + build-depends: base == 4.* + , directory + , process + , tasty + , tasty-hunit + , tasty-ant-xml >= 1.1.6 + hs-source-dirs: test/wrapper + main-is: Main.hs + ghc-options: -Wall diff --git a/src/Ide/Cradle.hs b/src/Ide/Cradle.hs deleted file mode 100644 index a2d976d29e..0000000000 --- a/src/Ide/Cradle.hs +++ /dev/null @@ -1,913 +0,0 @@ -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE NamedFieldPuns #-} -{-# LANGUAGE LambdaCase #-} -{-# LANGUAGE GADTs #-} - -module Ide.Cradle where - -import Control.Exception -import Data.Foldable (toList) -import Data.Function ((&)) -import Data.List (isPrefixOf, sortOn, find) -import Data.List.NonEmpty (NonEmpty) -import qualified Data.List.NonEmpty as NonEmpty -import qualified Data.Map as Map -import Data.Maybe (listToMaybe, mapMaybe, isJust) -import Data.Ord (Down(..)) -import Data.String (IsString(..)) -import qualified Data.Text as T -import Distribution.Helper (Package, projectPackages, pUnits, - pSourceDir, ChComponentInfo(..), - unChModuleName, Ex(..), ProjLoc(..), - QueryEnv, mkQueryEnv, runQuery, - Unit, unitInfo, uiComponents, - ChEntrypoint(..), UnitInfo(..), - qePrograms, ghcProgram) -import Distribution.Helper.Discover (findProjects, getDefaultDistDir) -import Ide.Logger -import HIE.Bios as Bios -import qualified HIE.Bios.Cradle as Bios -import HIE.Bios.Types (CradleAction(..)) -import qualified HIE.Bios.Types as Bios -import System.Directory (getCurrentDirectory, canonicalizePath, findExecutable) -import System.Exit -import System.FilePath -import System.Process (readCreateProcessWithExitCode, shell, CreateProcess(..)) - - --- --------------------------------------------------------------------- - --- | Find the cradle that the given File belongs to. --- --- First looks for a "hie.yaml" file in the directory of the file --- or one of its parents. If this file is found, the cradle --- is read from the config. If this config does not comply to the "hie.yaml" --- specification, an error is raised. --- --- If no "hie.yaml" can be found, the implicit config is used. --- The implicit config uses different heuristics to determine the type --- of the project that may or may not be accurate. -findLocalCradle :: FilePath -> IO (Cradle CabalHelper) -findLocalCradle fp = do - cradleConf <- Bios.findCradle fp - crdl <- case cradleConf of - Just yaml -> do - debugm $ "Found \"" ++ yaml ++ "\" for \"" ++ fp ++ "\"" - crdl <- Bios.loadCradle yaml - return $ fmap (const CabalNone) crdl - Nothing -> cabalHelperCradle fp - logm $ "Module \"" ++ fp ++ "\" is loaded by Cradle: " ++ show crdl - return crdl - --- | Check if the given cradle is a stack cradle. --- This might be used to determine the GHC version to use on the project. --- If it is a stack-cradle, we have to use @"stack path --compiler-exe"@ --- otherwise we may ask `ghc` directly what version it is. -isStackCradle :: Cradle CabalHelper -> Bool -isStackCradle crdl = Bios.isStackCradle crdl || cabalHelperStackCradle crdl - where - cabalHelperStackCradle = - (`elem` [Bios.Other Stack, Bios.Other StackNone]) - . Bios.actionName - . Bios.cradleOptsProg - - --- | Check if the given cradle is a cabal cradle. --- This might be used to determine the GHC version to use on the project. --- If it is a stack-cradle, we have to use @"stack path --compiler-exe"@ --- otherwise we may ask @ghc@ directly what version it is. -isCabalCradle :: Cradle CabalHelper -> Bool -isCabalCradle crdl = Bios.isCabalCradle crdl || cabalHelperCabalCradle crdl - where - cabalHelperCabalCradle = - (`elem` [Bios.Other CabalV2, Bios.Other CabalNone]) - . Bios.actionName - . Bios.cradleOptsProg - -data CabalHelper - = Stack - | StackNone - | CabalV2 - | CabalNone - deriving (Show, Eq, Ord) - --- | Execute @ghc@ that is based on the given cradle. --- Output must be a single line. If an error is raised, e.g. the command --- failed, a 'Nothing' is returned. --- The exact error is written to logs. --- --- E.g. for a stack cradle, we use @stack ghc@ and for a cabal cradle --- we are taking the @ghc@ that is on the path. -execProjectGhc :: Cradle CabalHelper -> [String] -> IO (Maybe String) -execProjectGhc crdl args = do - isStackInstalled <- isJust <$> findExecutable "stack" - -- isCabalInstalled <- isJust <$> findExecutable "cabal" - ghcOutput <- if isStackCradle crdl && isStackInstalled - then do - logm $ "Executing Stack GHC with args: " <> unwords args - catch (Just <$> tryCommand crdl stackCmd) $ \(_ :: IOException) -> do - errorm $ "Command `" ++ stackCmd ++"` failed." - execWithGhc - -- The command `cabal v2-exec -v0 ghc` only works if the project has been - -- built already. - -- This command must work though before the project is build. - -- Therefore, fallback to "ghc" on the path. - -- - -- else if isCabalCradle crdl && isCabalInstalled then do - -- let cmd = "cabal v2-exec -v0 ghc -- " ++ unwords args - -- catch (Just <$> tryCommand crdl cmd) $ \(_ ::IOException) -> do - -- errorm $ "Command `" ++ cmd ++ "` failed." - -- return Nothing - else do - logm $ "Executing GHC on path with args: " <> unwords args - execWithGhc - debugm $ "GHC Output: \"" ++ show ghcOutput ++ "\"" - return ghcOutput - where - stackCmd = "stack ghc -- " ++ unwords args - plainCmd = "ghc " ++ unwords args - - execWithGhc = - catch (Just <$> tryCommand crdl plainCmd) $ \(_ :: IOException) -> do - errorm $ "Command `" ++ plainCmd ++"` failed." - return Nothing - -tryCommand :: Cradle CabalHelper -> String -> IO String -tryCommand crdl cmd = do - let p = (shell cmd) { cwd = Just (cradleRootDir crdl) } - (code, sout, serr) <- readCreateProcessWithExitCode p "" - case code of - ExitFailure e -> do - let errmsg = concat - [ "`" - , cmd - , "`: Exit failure: " - , show e - , ", stdout: " - , sout - , ", stderr: " - , serr - ] - errorm errmsg - throwIO $ userError errmsg - - ExitSuccess -> return $ T.unpack . T.strip . head . T.lines $ T.pack sout - - --- | Get the directory of the libdir based on the project ghc. -getProjectGhcLibDir :: Cradle CabalHelper -> IO (Maybe FilePath) -getProjectGhcLibDir crdl = - execProjectGhc crdl ["--print-libdir"] >>= \case - Nothing -> do - errorm "Could not obtain the libdir." - return Nothing - mlibdir -> return mlibdir - - -- --------------------------------------------------------------------- - - -{- | Finds a Cabal v2-project, Cabal v1-project or a Stack project -relative to the given FilePath. -Cabal v2-project and Stack have priority over Cabal v1-project. -This entails that if a Cabal v1-project can be identified, it is -first checked whether there are Stack projects or Cabal v2-projects -before it is concluded that this is the project root. -Cabal v2-projects and Stack projects are equally important. -Due to the lack of user-input we have to guess which project it -should rather be. -This guessing has no guarantees and may change at any time. - -=== Example: - -Assume the following project structure: - -@ - / - └── Foo/ - ├── Foo.cabal - ├── stack.yaml - ├── cabal.project - ├── src - │ └── Lib.hs - └── B/ - ├── B.cabal - └── src/ - └── Lib2.hs -@ - -Assume the call @findCabalHelperEntryPoint "\/Foo\/B\/src\/Lib2.hs"@. -We now want to know to which project "\/Foo\/B\/src\/Lib2.hs" belongs to -and what the projects root is. If we only do a naive search to find the -first occurrence of either "B.cabal", "stack.yaml", "cabal.project" -or "Foo.cabal", we might assume that the location of "B.cabal" marks -the project's root directory of which "\/Foo\/B\/src\/Lib2.hs" is part of. -However, there is also a "cabal.project" and "stack.yaml" in the parent -directory, which add the package @B@ as a package. -So, the compilation of the package @B@, and the file "src\/Lib2.hs" in it, -does not only depend on the definitions in "B.cabal", but also -on "stack.yaml" and "cabal.project". -The project root is therefore "\/Foo\/". -Only if there is no "stack.yaml" or "cabal.project" in any of the ancestor -directories, it is safe to assume that "B.cabal" marks the root of the project. - -Thus: - ->>> findCabalHelperEntryPoint "/Foo/B/src/Lib2.hs -Just (Ex (ProjLocStackYaml { plStackYaml = "/Foo/"})) - -or - ->>> findCabalHelperEntryPoint "/Foo/B/src/Lib2.hs" -Just (Ex (ProjLocV2File { plProjectDirV2 = "/Foo/"})) - -In the given example, it is not guaranteed which project type is found, -it is only guaranteed that it will not identify the project -as a cabal v1-project. Note that with cabal-helper version (1.0), -by default a *.cabal file is identified as a 'ProjLocV2Dir' project. -The same issue as before exists and we look for a 'ProjLocV2File' or -'ProjLocStackYaml' before deciding that 'ProjLocV2Dir' marks the project root. - -Note that this will not return any project types for which the corresponding -build tool is not on the PATH. This is "stack" and "cabal" for stack and cabal -(both v1 and v2) projects respectively. --} -findCabalHelperEntryPoint :: FilePath -> IO (Maybe (Ex ProjLoc)) -findCabalHelperEntryPoint fp = do - allProjs <- concat <$> mapM findProjects (ancestors (takeDirectory fp)) - - debugm $ "Cabal-Helper found these projects: " ++ show (map (\(Ex x) -> show x) allProjs) - - -- We only want to return projects that we have the build tools installed for - isStackInstalled <- isJust <$> findExecutable "stack" - isCabalInstalled <- isJust <$> findExecutable "cabal" - let supportedProjs = filter (\x -> supported x isStackInstalled isCabalInstalled) allProjs - debugm $ "These projects have the build tools installed: " ++ show (map (\(Ex x) -> show x) supportedProjs) - - case filter (\p -> isCabalV2FileProject p || isStackProject p) supportedProjs of - (x:_) -> return $ Just x - [] -> case filter isCabalProject supportedProjs of - (x:_) -> return $ Just x - [] -> return Nothing - where - supported :: Ex ProjLoc -> Bool -> Bool -> Bool - supported (Ex ProjLocStackYaml {}) stackInstalled _ = stackInstalled - supported (Ex ProjLocV2Dir {}) _ cabalInstalled = cabalInstalled - supported (Ex ProjLocV2File {}) _ cabalInstalled = cabalInstalled - supported (Ex ProjLocV1Dir {}) _ cabalInstalled = cabalInstalled - supported (Ex ProjLocV1CabalFile {}) _ cabalInstalled = cabalInstalled - -isStackProject :: Ex ProjLoc -> Bool -isStackProject (Ex ProjLocStackYaml {}) = True -isStackProject _ = False - -isCabalV2FileProject :: Ex ProjLoc -> Bool -isCabalV2FileProject (Ex ProjLocV2File {}) = True -isCabalV2FileProject _ = False - -isCabalProject :: Ex ProjLoc -> Bool -isCabalProject (Ex ProjLocV1CabalFile {}) = True -isCabalProject (Ex ProjLocV1Dir {}) = True -isCabalProject (Ex ProjLocV2File {}) = True -isCabalProject (Ex ProjLocV2Dir {}) = True -isCabalProject _ = False - -{- | Given a FilePath, find the cradle the FilePath belongs to. - -Finds the Cabal Package the FilePath is most likely a part of -and creates a cradle whose root directory is the directory -of the package the File belongs to. - -It is not required that the FilePath given actually exists. If it does not -exist or is not part of any of the packages in the project, a "None"-cradle is -produced. -See for what a "None"-cradle is. -The "None"-cradle can still be used to query for basic information, such as -the GHC version used to build the project. However, it can not be used to -load any of the files in the project. - -== General Approach - -Given a FilePath that we want to load, we need to create a cradle -that can compile and load the given FilePath. -In Cabal-Helper, there is no notion of a cradle, but a project -consists of multiple packages that contain multiple units. -Each unit may consist of multiple components. -A unit is the smallest part of code that Cabal (the library) can compile. -Examples are executables, libraries, tests or benchmarks are all units. -Each of this units has a name that is unique within a build-plan, -such as "exe:hie" which represents the executable of the Haskell IDE Engine. - -In principle, a unit is what hie-bios considers to be a cradle. -However, to find out to which unit a FilePath belongs, we have to initialise -the unit, e.g. configure its dependencies and so on. When discovering a cradle -we do not want to pay for this upfront, but rather when we actually want to -load a Module in the project. Therefore, we only identify the package the -FilePath is part of and decide which unit to load when 'runCradle' is executed. - -Thus, to find the options required to compile and load the given FilePath, -we have to do the following: - - 1. Identify the package that contains the FilePath (should be unique) - Happens in 'cabalHelperCradle' - 2. Find the unit that that contains the FilePath (May be non-unique) - Happens in 'cabalHelperAction' - 3. Find the component that exposes the FilePath (May be non-unique) - Happens in 'cabalHelperAction' - -=== Identify the package that contains the FilePath - -The function 'cabalHelperCradle' does the first step only. -It starts by querying Cabal-Helper to find the project's root. -See 'findCabalHelperEntryPoint' for details how this is done. -Once the root of the project is defined, we query Cabal-Helper for all packages -that are defined in the project and match by the packages source directory -which package the given FilePath is most likely to be a part of. -E.g. if the source directory of the package is the most concrete -prefix of the FilePath, the FilePath is in that package. -After the package is identified, we create a cradle where cradle's root -directory is set to the package's source directory. This is necessary, -because compiler options obtained from a component, are relative -to the source directory of the package the component is part of. - -=== Find the unit that that contains the FilePath - -In 'cabalHelperAction' we want to load a given FilePath, already knowing -which package the FilePath is part of. Now we obtain all Units that are part -of the package and match by the source directories (plural is intentional), -to which unit the given FilePath most likely belongs to. If no unit can be -obtained, e.g. for every unit, no source directory is a prefix of the FilePath, -we return an error code, since this is not allowed to happen. -If there are multiple matches, which is possible, we check whether any of the -components defined in the unit exposes or defines the given FilePath as a module. - -=== Find the component that exposes the FilePath - -A component defines the options that are necessary to compile a FilePath that -is in the component. It also defines which modules are in the component. -Therefore, we translate the given FilePath into a module name, relative to -the unit's source directory, and check if the module name is exposed by the -component. There is a special case, executables define a FilePath, for the -file that contains the 'main'-function, that is relative to the unit's source -directory. - -After the component has been identified, we can actually retrieve the options -required to load and compile the given file. - -== Examples - -=== Mono-Repo - -Assume the project structure: - -@ - / - └── Mono/ - ├── cabal.project - ├── stack.yaml - ├── A/ - │ ├── A.cabal - │ └── Lib.hs - └── B/ - ├── B.cabal - └── Exe.hs -@ - -Currently, Haskell IDE Engine needs to know on startup which GHC version is -needed to compile the project. This information is needed to show warnings to -the user if the GHC version on the project does not agree with the GHC version -that was used to compile Haskell IDE Engine. - -Therefore, the function 'findLocalCradle' is invoked with a dummy FilePath, -such as "\/Mono\/Lib.hs". Since there will be no package that contains this -dummy FilePath, the result will be a None-cradle. - -Either - ->>> findLocalCradle "/Mono/Lib.hs" -Cradle { cradleRootDir = "/Mono/", CradleAction { actionName = "Cabal-Helper-Stack-None", ..} } - -or - ->>> findLocalCradle "/Mono/Lib.hs" -Cradle { cradleRootDir = "/Mono/", CradleAction { actionName = "Cabal-Helper-Cabal-V2-None", ..} } - -The cradle result of this invocation is only used to obtain the GHC version, -which is safe, since it only checks if the cradle is a 'stack' project or -a 'cabal' project. - - -If we are trying to load the executable: - ->>> findLocalCradle "/Mono/B/Exe.hs" -Cradle { cradleRootDir = "/Mono/", CradleAction { actionName = "Cabal-Helper-Cabal-V2", ..} } - -we will detect correctly the compiler options, by first finding the appropriate -package, followed by traversing the units in the package and finding the -component that exposes the executable by FilePath. - -=== No explicit executable folder - -Assume the project structure: - -@ - / - └── Library/ - ├── cabal.project - ├── stack.yaml - ├── Library.cabal - └── src - ├── Lib.hs - └── Exe.hs -@ - -There are different dependencies for the library "Lib.hs" and the -executable "Exe.hs". If we are trying to load the executable "src\/Exe.hs" -we will correctly identify the executable unit, and correctly initialise -dependencies of "exe:Library". -It will be correct even if we load the unit "lib:Library" before -the "exe:Library" because the unit "lib:Library" does not expose -a module @"Exe"@. - -=== Sub package - -Assume the project structure: - -@ - / - └── Repo/ - ├── cabal.project - ├── stack.yaml - ├── Library.cabal - ├── src - | └── Lib.hs - └── SubRepo - ├── SubRepo.cabal - └── Lib2.hs -@ - -When we try to load "\/Repo\/SubRepo\/Lib2.hs", we need to identify root -of the project, which is "\/Repo\/" but set the root directory of the cradle -responsible to load "\/Repo\/SubRepo\/Lib2.hs" to "\/Repo\/SubRepo", since -the compiler options obtained from Cabal-Helper are relative to the package -source directory, which is "\/Repo\/SubRepo". - --} -cabalHelperCradle :: FilePath -> IO (Cradle CabalHelper) -cabalHelperCradle file = do - projM <- findCabalHelperEntryPoint file - case projM of - Nothing -> do - errorm $ "Could not find a Project for file: " ++ file - cwd <- getCurrentDirectory - return - Cradle { cradleRootDir = cwd - , cradleOptsProg = - CradleAction { actionName = Bios.Direct - , runCradle = \_ _ -> - return - $ CradleSuccess - ComponentOptions - { componentOptions = [file, fixImportDirs cwd "-i."] - , componentRoot = cwd - , componentDependencies = [] - } - , runGhcCmd = \args -> Bios.readProcessWithCwd cwd "ghc" args "" - } - } - Just (Ex proj) -> do - logm $ "Cabal-Helper decided to use: " ++ show proj - -- Find the root of the project based on project type. - let root = projectRootDir proj - -- Create a suffix for the cradle name. - -- Purpose is mainly for easier debugging. - let actionNameSuffix = projectType proj - debugm $ "Cabal-Helper dirs: " ++ show [root, file] - let dist_dir = getDefaultDistDir proj - env <- mkQueryEnv proj dist_dir - packages <- runQuery projectPackages env - -- Find the package the given file may belong to. - -- If it does not belong to any package, create a none-cradle. - -- We might want to find a cradle without actually loading anything. - -- Useful if we only want to determine a ghc version to use. - case packages `findPackageFor` file of - Nothing -> do - debugm $ "Could not find a package for the file: " ++ file - debugm - "This is perfectly fine if we only want to determine the GHC version." - return - Cradle { cradleRootDir = root - , cradleOptsProg = - CradleAction { actionName = Bios.Other (projectNoneType proj) - , runCradle = \_ _ -> return CradleNone - , runGhcCmd = \_ -> pure CradleNone - } - } - Just realPackage -> do - debugm $ "Cabal-Helper cradle package: " ++ show realPackage - -- Field `pSourceDir` often has the form `/./plugin` - -- but we only want `/plugin` - normalisedPackageLocation <- canonicalizePath $ pSourceDir realPackage - debugm - $ "Cabal-Helper normalisedPackageLocation: " - ++ normalisedPackageLocation - return - Cradle { cradleRootDir = normalisedPackageLocation - , cradleOptsProg = - CradleAction { actionName = Bios.Other actionNameSuffix - , runCradle = \_ fp -> cabalHelperAction - (Ex proj) - env - realPackage - normalisedPackageLocation - fp - , runGhcCmd = \args -> do - let programs = qePrograms env - Bios.readProcessWithCwd normalisedPackageLocation (ghcProgram programs) args "" - } - } - --- | Cradle Action to query for the ComponentOptions that are needed --- to load the given FilePath. --- This Function is not supposed to throw any exceptions and use --- 'CradleLoadResult' to indicate errors. -cabalHelperAction :: Ex ProjLoc -- ^ Project location, can be used - -- to present build-tool - -- agnostic error messages. - -> QueryEnv v -- ^ Query Env created by 'mkQueryEnv' - -- with the appropriate 'distdir' - -> Package v -- ^ Package this cradle is part for. - -> FilePath -- ^ Root directory of the cradle - -- this action belongs to. - -> FilePath -- ^ FilePath to load, expected to be an absolute path. - -> IO (CradleLoadResult ComponentOptions) -cabalHelperAction proj env package root fp = do - -- Get all unit infos the given FilePath may belong to - let units = pUnits package - -- make the FilePath to load relative to the root of the cradle. - let relativeFp = makeRelative root fp - debugm $ "Relative Module FilePath: " ++ relativeFp - getComponent proj env (toList units) relativeFp - >>= \case - Right comp -> do - let fs' = getFlags comp - let fs = map (fixImportDirs root) fs' - let targets = getTargets comp relativeFp - let ghcOptions = fs ++ targets - debugm $ "Flags for \"" ++ fp ++ "\": " ++ show ghcOptions - debugm $ "Component Infos: " ++ show comp - return - $ CradleSuccess - ComponentOptions { componentOptions = ghcOptions - , componentRoot = root - , componentDependencies = [] - } - Left err -> return - $ CradleFail - $ CradleError - [] - (ExitFailure 2) - err - --- | Fix occurrences of "-i." to "-i" --- Flags obtained from cabal-helper are relative to the package --- source directory. This is less resilient to using absolute paths, --- thus, we fix it here. -fixImportDirs :: FilePath -> String -> String -fixImportDirs base_dir arg = - if "-i" `isPrefixOf` arg - then let dir = drop 2 arg - -- the flag "-i" has special meaning. - in if not (null dir) && isRelative dir then ("-i" ++ base_dir dir) - else arg - else arg - - --- | Get the component the given FilePath most likely belongs to. --- Lazily ask units whether the given FilePath is part of one of their --- component's. --- If a Module belongs to multiple components, it is not specified which --- component will be loaded. --- The given FilePath must be relative to the Root of the project --- the given units belong to. -getComponent - :: forall pt. Ex ProjLoc -> QueryEnv pt -> [Unit pt] -> FilePath -> IO (Either [String] ChComponentInfo) -getComponent proj env unitCandidates fp = getComponent' [] [] unitCandidates >>= - \case - (tried, failed, Nothing) -> return (Left $ buildErrorMsg tried failed) - (_, _, Just comp) -> return (Right comp) - where - getComponent' :: [UnitInfo] -> [(Unit pt, IOException)] -> [Unit pt] -> IO ([UnitInfo], [(Unit pt, IOException)], Maybe ChComponentInfo) - getComponent' triedUnits failedUnits [] = return (triedUnits, failedUnits, Nothing) - getComponent' triedUnits failedUnits (unit : units) = - try (runQuery (unitInfo unit) env) >>= \case - Left (e :: IOException) -> do - warningm $ "Catching and swallowing an IOException: " ++ show e - warningm - $ "The Exception was thrown in the context of finding" - ++ " a component for \"" - ++ fp - ++ "\" in the unit: " - ++ show unit - getComponent' triedUnits ((unit, e):failedUnits) units - Right ui -> do - let components = Map.elems (uiComponents ui) - debugm $ "Unit Info: " ++ show ui - case find (fp `partOfComponent`) components of - Nothing -> getComponent' (ui:triedUnits) failedUnits units - comp -> return (triedUnits, failedUnits, comp) - - buildErrorMsg :: [UnitInfo] -> [(Unit pt, IOException)] -> [String] - buildErrorMsg triedUnits failedUnits = - concat - [ [ "Could not obtain flags for: \"" ++ fp ++ "\"." - , "" - ] - , concat - [ concat - [ [ "This module was not part of any component we are aware of." - , "" - ] - , concatMap ppShowUnitInfo triedUnits - , [ "" - , "" - ] - , if isStackProject proj - then stackSpecificInstructions - else cabalSpecificInstructions - ] - | not (null triedUnits) - ] - , concat - [ - [ "We could not build all components." - , "If one of these components exposes this Module, make sure they compile." - , "You can try to invoke the commands yourself." - , "The following commands failed:" - ] - ++ concatMap (ppShowIOException . snd) failedUnits - | not (null failedUnits) - ] - ] - - stackSpecificInstructions :: [String] - stackSpecificInstructions = - [ "To expose a module, refer to:" - , "https://docs.haskellstack.org/en/stable/GUIDE/" - , "If you are using `package.yaml` then you don't have to manually expose modules." - , "Maybe you didn't set the source directories for your project correctly." - ] - - cabalSpecificInstructions :: [String] - cabalSpecificInstructions = - [ "To expose a module, refer to:" - , "https://www.haskell.org/cabal/users-guide/developing-packages.html" - , "" - ] - - ppShowUnitInfo :: UnitInfo -> [String] - ppShowUnitInfo u = - u - & uiComponents - & Map.toList - & map - (\(name, info) -> - "Component: " ++ show name ++ " with source directory: " ++ show (ciSourceDirs info) - ) - - - ppShowIOException :: IOException -> [String] - ppShowIOException e = - [ "" - , show e - ] - --- | Check whether the given FilePath is part of the Component. --- A FilePath is part of the Component if and only if: --- --- * One Component's 'ciSourceDirs' is a prefix of the FilePath --- * The FilePath, after converted to a module name, --- is a in the Component's Targets, or the FilePath is --- the executable in the component. --- --- The latter is achieved by making the FilePath relative to the 'ciSourceDirs' --- and then replacing Path separators with ".". --- To check whether the given FilePath is the executable of the Component, --- we have to check whether the FilePath, including 'ciSourceDirs', --- is part of the targets in the Component. -partOfComponent :: - -- | FilePath relative to the package root. - FilePath -> - -- | Component to check whether the given FilePath is part of it. - ChComponentInfo -> - Bool -partOfComponent fp' comp = - inTargets (ciSourceDirs comp) fp' (getTargets comp fp') - where - -- Check if the FilePath is in an executable or setup's main-is field - inMainIs :: FilePath -> Bool - inMainIs fp - | ChExeEntrypoint mainIs _ <- ciEntrypoints comp = mainIs == fp - | ChSetupEntrypoint mainIs <- ciEntrypoints comp = mainIs == fp - | otherwise = False - - inTargets :: [FilePath] -> FilePath -> [String] -> Bool - inTargets sourceDirs fp targets = - let candidates = relativeTo fp sourceDirs - in any (existsInTargets targets fp) candidates - - existsInTargets :: [String] -> FilePath -> FilePath -> Bool - existsInTargets targets absFp relFp = or - [ any (`elem` targets) [getModuleName relFp, absFp] - , inMainIs relFp - ] - - getModuleName :: FilePath -> String - getModuleName fp = map - (\c -> if isPathSeparator c - then '.' - else c) - (dropExtension fp) - --- | Get the flags necessary to compile the given component. -getFlags :: ChComponentInfo -> [String] -getFlags = ciGhcOptions - --- | Get all Targets of a Component, since we want to load all components. --- FilePath is needed for the special case that the Component is an Exe. --- The Exe contains a Path to the Main which is relative to some entry --- in 'ciSourceDirs'. --- We monkey-patch this by supplying the FilePath we want to load, --- which is part of this component, and select the 'ciSourceDir' we actually want. --- See the Documentation of 'ciSourceDir' to why this contains multiple entries. -getTargets :: ChComponentInfo -> FilePath -> [String] -getTargets comp fp = case ciEntrypoints comp of - ChSetupEntrypoint {} -> [] - ChLibEntrypoint { chExposedModules, chOtherModules } - -> map unChModuleName (chExposedModules ++ chOtherModules) - ChExeEntrypoint { chMainIs, chOtherModules } - -> [sourceDir chMainIs | Just sourceDir <- [sourceDirs]] - ++ map unChModuleName chOtherModules - where - sourceDirs = find (`isFilePathPrefixOf` fp) (ciSourceDirs comp) - --- | For all packages in a project, find the project the given FilePath --- belongs to most likely. -findPackageFor :: NonEmpty (Package pt) -> FilePath -> Maybe (Package pt) -findPackageFor packages fp = packages - & NonEmpty.toList - & sortOn (Down . pSourceDir) - & filter (\p -> pSourceDir p `isFilePathPrefixOf` fp) - & listToMaybe - - -projectRootDir :: ProjLoc qt -> FilePath -projectRootDir ProjLocV1CabalFile { plProjectDirV1 } = plProjectDirV1 -projectRootDir ProjLocV1Dir { plProjectDirV1 } = plProjectDirV1 -projectRootDir ProjLocV2File { plProjectDirV2 } = plProjectDirV2 -projectRootDir ProjLocV2Dir { plProjectDirV2 } = plProjectDirV2 -projectRootDir ProjLocStackYaml { plStackYaml } = takeDirectory plStackYaml - -projectType :: ProjLoc qt -> CabalHelper -projectType ProjLocV1CabalFile {} = CabalV2 -projectType ProjLocV1Dir {} = CabalV2 -projectType ProjLocV2File {} = CabalV2 -projectType ProjLocV2Dir {} = CabalV2 -projectType ProjLocStackYaml {} = Stack - -projectNoneType :: ProjLoc qt -> CabalHelper -projectNoneType ProjLocV1CabalFile {} = CabalNone -projectNoneType ProjLocV1Dir {} = CabalNone -projectNoneType ProjLocV2File {} = CabalNone -projectNoneType ProjLocV2Dir {} = CabalNone -projectNoneType ProjLocStackYaml {} = StackNone - --- ---------------------------------------------------------------------------- --- --- Utility functions to manipulate FilePath's --- --- ---------------------------------------------------------------------------- - --- | Helper function to make sure that both FilePaths are normalised. --- Checks whether the first FilePath is a Prefix of the second FilePath. --- Intended usage: --- --- >>> isFilePathPrefixOf "./src/" "./src/File.hs" --- True --- --- >>> isFilePathPrefixOf "./src" "./src/File.hs" --- True --- --- >>> isFilePathPrefixOf "./src/././" "./src/File.hs" --- True --- --- >>> isFilePathPrefixOf "./src" "./src-dir/File.hs" --- False -isFilePathPrefixOf :: FilePath -> FilePath -> Bool -isFilePathPrefixOf dir fp = isJust $ stripFilePath dir fp - --- | Strip the given directory from the filepath if and only if --- the given directory is a prefix of the filepath. --- --- >>> stripFilePath "app" "app/File.hs" --- Just "File.hs" --- --- >>> stripFilePath "src" "app/File.hs" --- Nothing --- --- >>> stripFilePath "src" "src-dir/File.hs" --- Nothing --- --- >>> stripFilePath "." "src/File.hs" --- Just "src/File.hs" --- --- >>> stripFilePath "app/" "./app/Lib/File.hs" --- Just "Lib/File.hs" --- --- >>> stripFilePath "/app/" "./app/Lib/File.hs" --- Nothing -- Nothing since '/app/' is absolute --- --- >>> stripFilePath "/app" "/app/Lib/File.hs" --- Just "Lib/File.hs" -stripFilePath :: FilePath -> FilePath -> Maybe FilePath -stripFilePath "." fp - | isRelative fp = Just fp - | otherwise = Nothing -stripFilePath dir' fp' - | Just relativeFpParts <- splitDir `stripPrefix` splitFp = Just (joinPath relativeFpParts) - | otherwise = Nothing - where - dir = normalise dir' - fp = normalise fp' - splitFp = splitPath fp - splitDir = splitPath dir - stripPrefix (x:xs) (y:ys) - | x `equalFilePath` y = stripPrefix xs ys - | otherwise = Nothing - stripPrefix [] ys = Just ys - stripPrefix _ [] = Nothing - --- | Obtain all ancestors from a given directory. --- --- >>> ancestors "a/b/c/d/e" --- [ "a/b/c/d/e", "a/b/c/d", "a/b/c", "a/b", "a", "." ] --- --- >>> ancestors "/a/b/c/d/e" --- [ "/a/b/c/d/e", "/a/b/c/d", "/a/b/c", "/a/b", "/a", "/" ] --- --- >>> ancestors "/a/b.hs" --- [ "/a/b.hs", "/a", "/" ] --- --- >>> ancestors "a/b.hs" --- [ "a/b.hs", "a", "." ] --- --- >>> ancestors "a/b/" --- [ "a/b" ] -ancestors :: FilePath -> [FilePath] -ancestors dir - | subdir `equalFilePath` dir = [dir] - | otherwise = dir : ancestors subdir - where - subdir = takeDirectory dir - --- | Assuming a FilePath @"src\/Lib\/Lib.hs"@ and a list of directories --- such as @["src", "app"]@, returns the given FilePath --- with a matching directory stripped away. --- If there are multiple matches, e.g. multiple directories are a prefix --- of the given FilePath we return all matches. --- Returns an empty list if no prefix matches the given FilePath. --- --- >>> relativeTo "src/Lib/Lib.hs" ["src"] --- ["Lib/Lib.hs"] --- --- >>> relativeTo "src/Lib/Lib.hs" ["app"] --- [] --- --- >>> relativeTo "src/Lib/Lib.hs" ["src", "src/Lib"] --- ["Lib/Lib.hs", "Lib.hs"] -relativeTo :: FilePath -> [FilePath] -> [FilePath] -relativeTo file sourceDirs = - mapMaybe (`stripFilePath` file) sourceDirs - --- | Returns a user facing display name for the cradle type, --- e.g. "Stack project" or "GHC session" -cradleDisplay :: IsString a => Cradle CabalHelper -> a -cradleDisplay cradle = fromString result - where - result - | Bios.isStackCradle cradle - || name - `elem` [Bios.Other Stack, Bios.Other StackNone] - = "Stack project" - | Bios.isCabalCradle cradle - || name - `elem` [Bios.Other CabalV2, Bios.Other CabalNone] - = "Cabal project" - | Bios.isDirectCradle cradle - = "GHC session" - | Bios.isMultiCradle cradle - = "Multi Component project" - | otherwise - = "project" - name = Bios.actionName (Bios.cradleOptsProg cradle) - --- --------------------------------------------------------------------- diff --git a/src/Ide/Version.hs b/src/Ide/Version.hs index fe6908e973..fcb9f2376b 100644 --- a/src/Ide/Version.hs +++ b/src/Ide/Version.hs @@ -5,14 +5,9 @@ -- and the current project's version module Ide.Version where -import Data.Maybe import Development.GitRev (gitCommitCount) import Options.Applicative.Simple (simpleVersion) -import Ide.Cradle (execProjectGhc) -import qualified HIE.Bios.Types as Bios -import qualified Ide.Cradle as Bios import qualified Paths_haskell_language_server as Meta -import System.Directory import System.Info hlsVersion :: String @@ -27,25 +22,5 @@ hlsVersion = , [" ", arch] , [" ", hlsGhcDisplayVersion] ] - --- --------------------------------------------------------------------- - -hlsGhcDisplayVersion :: String -hlsGhcDisplayVersion = compilerName ++ "-" ++ VERSION_ghc - -getProjectGhcVersion :: Bios.Cradle Bios.CabalHelper -> IO String -getProjectGhcVersion crdl = - fmap - (fromMaybe "No System GHC Found.") - (execProjectGhc crdl ["--numeric-version"]) - - -hlsGhcVersion :: String -hlsGhcVersion = VERSION_ghc - --- --------------------------------------------------------------------- - -checkCabalInstall :: IO Bool -checkCabalInstall = isJust <$> findExecutable "cabal" - --- --------------------------------------------------------------------- + where + hlsGhcDisplayVersion = compilerName ++ "-" ++ VERSION_ghc diff --git a/stack-8.10.1.yaml b/stack-8.10.1.yaml index 73b0855aff..c28931ef18 100644 --- a/stack-8.10.1.yaml +++ b/stack-8.10.1.yaml @@ -6,10 +6,7 @@ packages: extra-deps: - Cabal-3.0.2.0 -# - cabal-helper-1.1.0.0 - hie-bios-0.6.1 -- github: DanielG/cabal-helper - commit: 79a5608778493bf32e74b54bbf1ea2729941e50f - cabal-plan-0.7.0.0 - clock-0.7.2 - floskell-0.10.3 diff --git a/stack-8.6.4.yaml b/stack-8.6.4.yaml index 2f673b24f8..56eb41a9ad 100644 --- a/stack-8.6.4.yaml +++ b/stack-8.6.4.yaml @@ -11,7 +11,6 @@ extra-deps: - bytestring-trie-0.2.5.0 - Cabal-3.0.2.0 - cabal-doctest-1.0.8 -- cabal-helper-1.1.0.0 - cabal-plan-0.5.0.0 - constrained-dynamic-0.1.0.0 - deque-0.4.3 diff --git a/stack-8.6.5.yaml b/stack-8.6.5.yaml index 2a6f9298e7..62db328d8c 100644 --- a/stack-8.6.5.yaml +++ b/stack-8.6.5.yaml @@ -10,7 +10,6 @@ extra-deps: - brittany-0.12.1.1@rev:2 - butcher-1.3.3.1 - Cabal-3.0.2.0 -- cabal-helper-1.1.0.0 - cabal-plan-0.6.2.0 - clock-0.7.2 - extra-1.7.3 diff --git a/stack-8.8.2.yaml b/stack-8.8.2.yaml index af8599e938..ad95d9ea5b 100644 --- a/stack-8.8.2.yaml +++ b/stack-8.8.2.yaml @@ -9,7 +9,6 @@ extra-deps: - brittany-0.12.1.1 - butcher-1.3.3.2 - bytestring-trie-0.2.5.0 -- cabal-helper-1.1.0.0 - clock-0.7.2 - constrained-dynamic-0.1.0.0 - extra-1.7.3 diff --git a/stack-8.8.3.yaml b/stack-8.8.3.yaml index de106549a8..bba9679ccc 100644 --- a/stack-8.8.3.yaml +++ b/stack-8.8.3.yaml @@ -7,7 +7,6 @@ packages: extra-deps: - apply-refact-0.7.0.0 - bytestring-trie-0.2.5.0 -- cabal-helper-1.1.0.0 - cabal-plan-0.6.2.0 - clock-0.7.2 - constrained-dynamic-0.1.0.0 diff --git a/stack.yaml b/stack.yaml index 88eb9f5d82..1ff400f465 100644 --- a/stack.yaml +++ b/stack.yaml @@ -10,7 +10,6 @@ extra-deps: - brittany-0.12.1.1@rev:2 - butcher-1.3.3.1 - Cabal-3.0.2.0 -- cabal-helper-1.1.0.0 - cabal-plan-0.6.2.0 - clock-0.7.2 - extra-1.7.3 diff --git a/test/utils/Test/Hls/Util.hs b/test/utils/Test/Hls/Util.hs index 65b024167e..c6b14a6ea1 100644 --- a/test/utils/Test/Hls/Util.hs +++ b/test/utils/Test/Hls/Util.hs @@ -14,6 +14,8 @@ module Test.Hls.Util , noLogConfig , setupBuildToolFiles , withFileLogging + , findExe + , withCurrentDirectoryInTmp -- , makeRequest -- , runIGM -- , runIGM' @@ -25,8 +27,10 @@ module Test.Hls.Util ) where +import Control.Applicative -- import Control.Concurrent.STM import Control.Monad +import Control.Monad.Trans.Maybe import Data.Default import Data.List (intercalate) -- import Data.Typeable @@ -43,6 +47,7 @@ import System.Directory import System.Environment import System.FilePath import qualified System.Log.Logger as L +import System.IO.Temp -- import Test.Hspec import Test.Hspec.Runner import Test.Hspec.Core.Formatters @@ -309,4 +314,53 @@ dummyLspFuncs = LspFuncs { clientCapabilities = def , getWorkspaceFolders = return Nothing , withProgress = \_ _ f -> f (const (return ())) , withIndefiniteProgress = \_ _ f -> f - } \ No newline at end of file + } + +findExeRecursive :: FilePath -> FilePath -> IO (Maybe FilePath) +findExeRecursive exe dir = do + me <- listToMaybe <$> findExecutablesInDirectories [dir] exe + case me of + Just e -> return (Just e) + Nothing -> do + subdirs <- (fmap (dir )) <$> listDirectory dir >>= filterM doesDirectoryExist + foldM (\acc subdir -> case acc of + Just y -> pure $ Just y + Nothing -> findExeRecursive exe subdir) + Nothing + subdirs + +-- | So we can find an executable with cabal run +-- since it doesnt put build tools on the path (only cabal test) +findExe :: String -> IO FilePath +findExe name = do + fp <- fmap fromJust $ runMaybeT $ + MaybeT (findExecutable name) <|> + MaybeT (findExeRecursive name "dist-newstyle") + makeAbsolute fp + +-- | Like 'withCurrentDirectory', but will copy the directory over to the system +-- temporary directory first to avoid haskell-language-server's source tree from +-- interfering with the cradle +withCurrentDirectoryInTmp :: FilePath -> IO a -> IO a +withCurrentDirectoryInTmp dir f = + withTempCopy dir $ \newDir -> + withCurrentDirectory newDir f + +withTempCopy :: FilePath -> (FilePath -> IO a) -> IO a +withTempCopy srcDir f = do + withSystemTempDirectory "hls-test" $ \newDir -> do + copyDir srcDir newDir + f newDir + +copyDir :: FilePath -> FilePath -> IO () +copyDir src dst = do + cnts <- listDirectory src + forM_ cnts $ \file -> do + unless (file `elem` ignored) $ do + let srcFp = src file + dstFp = dst file + isDir <- doesDirectoryExist srcFp + if isDir + then createDirectory dstFp >> copyDir srcFp dstFp + else copyFile srcFp dstFp + where ignored = ["dist", "dist-newstyle", ".stack-work"] diff --git a/test/wrapper/Main.hs b/test/wrapper/Main.hs new file mode 100644 index 0000000000..6f2795a579 --- /dev/null +++ b/test/wrapper/Main.hs @@ -0,0 +1,33 @@ +import Data.List +import Data.Char +import Test.Hls.Util +import Test.Tasty +import Test.Tasty.HUnit +import System.Process + +main :: IO () +main = do + flushStackEnvironment + defaultMain $ + testGroup "haskell-language-server-wrapper" [projectGhcVersionTests] + +projectGhcVersionTests :: TestTree +projectGhcVersionTests = testGroup "--project-ghc-version" + [ testCase "stack with ghc 8.10.1" $ + testDir "test/wrapper/testdata/stack-8.10.1" "8.10.1" + , testCase "stack with ghc 8.8.3" $ + testDir "test/wrapper/testdata/stack-8.8.3" "8.8.3" + , testCase "cabal with global ghc" $ do + ghcVer <- trim <$> readProcess "ghc" ["--numeric-version"] "" + testDir "test/wrapper/testdata/cabal-cur-ver" ghcVer + ] + +testDir :: FilePath -> String -> Assertion +testDir dir expectedVer = do + wrapper <- findExe "haskell-language-server-wrapper" + withCurrentDirectoryInTmp dir $ do + actualVer <- trim <$> readProcess wrapper ["--project-ghc-version"] "" + actualVer @?= expectedVer + +trim :: String -> String +trim = dropWhileEnd isSpace diff --git a/test/wrapper/testdata/cabal-cur-ver/Lib.hs b/test/wrapper/testdata/cabal-cur-ver/Lib.hs new file mode 100644 index 0000000000..30bf1ec6b8 --- /dev/null +++ b/test/wrapper/testdata/cabal-cur-ver/Lib.hs @@ -0,0 +1,2 @@ +module Lib where +foo = 42 diff --git a/test/wrapper/testdata/cabal-cur-ver/cabal-cur-ver.cabal b/test/wrapper/testdata/cabal-cur-ver/cabal-cur-ver.cabal new file mode 100644 index 0000000000..a64735e4d4 --- /dev/null +++ b/test/wrapper/testdata/cabal-cur-ver/cabal-cur-ver.cabal @@ -0,0 +1,7 @@ +cabal-version: 2.4 +name: cabal-cur-ver +version: 0.1.0.0 +library + exposed-modules: Lib + build-depends: base + default-language: Haskell2010 diff --git a/test/wrapper/testdata/cabal-cur-ver/cabal.project b/test/wrapper/testdata/cabal-cur-ver/cabal.project new file mode 100644 index 0000000000..e6fdbadb43 --- /dev/null +++ b/test/wrapper/testdata/cabal-cur-ver/cabal.project @@ -0,0 +1 @@ +packages: . diff --git a/test/wrapper/testdata/stack-8.10.1/Lib.hs b/test/wrapper/testdata/stack-8.10.1/Lib.hs new file mode 100644 index 0000000000..30bf1ec6b8 --- /dev/null +++ b/test/wrapper/testdata/stack-8.10.1/Lib.hs @@ -0,0 +1,2 @@ +module Lib where +foo = 42 diff --git a/test/wrapper/testdata/stack-8.10.1/foo.cabal b/test/wrapper/testdata/stack-8.10.1/foo.cabal new file mode 100644 index 0000000000..affc654cad --- /dev/null +++ b/test/wrapper/testdata/stack-8.10.1/foo.cabal @@ -0,0 +1,7 @@ +cabal-version: 2.4 +name: foo +version: 0.1.0.0 +library + exposed-modules: Lib + build-depends: base + default-language: Haskell2010 diff --git a/test/wrapper/testdata/stack-8.10.1/stack.yaml b/test/wrapper/testdata/stack-8.10.1/stack.yaml new file mode 100644 index 0000000000..409e7fe489 --- /dev/null +++ b/test/wrapper/testdata/stack-8.10.1/stack.yaml @@ -0,0 +1 @@ +resolver: ghc-8.10.1 diff --git a/test/wrapper/testdata/stack-8.8.3/Lib.hs b/test/wrapper/testdata/stack-8.8.3/Lib.hs new file mode 100644 index 0000000000..30bf1ec6b8 --- /dev/null +++ b/test/wrapper/testdata/stack-8.8.3/Lib.hs @@ -0,0 +1,2 @@ +module Lib where +foo = 42 diff --git a/test/wrapper/testdata/stack-8.8.3/foo.cabal b/test/wrapper/testdata/stack-8.8.3/foo.cabal new file mode 100644 index 0000000000..affc654cad --- /dev/null +++ b/test/wrapper/testdata/stack-8.8.3/foo.cabal @@ -0,0 +1,7 @@ +cabal-version: 2.4 +name: foo +version: 0.1.0.0 +library + exposed-modules: Lib + build-depends: base + default-language: Haskell2010 diff --git a/test/wrapper/testdata/stack-8.8.3/stack.yaml b/test/wrapper/testdata/stack-8.8.3/stack.yaml new file mode 100644 index 0000000000..fc8cd8cd8f --- /dev/null +++ b/test/wrapper/testdata/stack-8.8.3/stack.yaml @@ -0,0 +1 @@ +resolver: ghc-8.8.3