Skip to content

Commit dc99a50

Browse files
lukel97lukel97
committed
Radical approach - don't use such a long name for the wrapper
1 parent 4219d51 commit dc99a50

7 files changed

Lines changed: 73 additions & 77 deletions

File tree

‎.github/workflows/build.yml‎

Lines changed: 4 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -34,13 +34,13 @@ jobs:
3434

3535

3636
- name: Build Server
37-
run: cabal build exe:haskell-language-server -O2 --builddir=../b --disable-documentation
37+
run: cabal build exe:haskell-language-server -O2 --disable-documentation
3838

3939
- name: Find Server Binary
4040
id: find_server_binary
4141
shell: bash
4242
run: |
43-
HLS=$(find ../b \( -name 'haskell-language-server' -o -name 'haskell-language-server.exe' \) -type f)
43+
HLS=$(find dist-newstyle \( -name 'haskell-language-server' -o -name 'haskell-language-server.exe' \) -type f)
4444
echo ::set-output name=hls_binary::$HLS
4545
4646
- name: Upload Server Binary
@@ -55,14 +55,14 @@ jobs:
5555

5656
- name: Build Wrapper
5757
if: matrix.ghc == '8.10.1'
58-
run: cabal build exe:haskell-language-server-wrapper -O2 --builddir=../b --disable-documentation -v
58+
run: cabal build exe:hls-wrapper -O2 --disable-documentation
5959

6060
- name: Find Wrapper Binary
6161
if: matrix.ghc == '8.10.1'
6262
id: find_wrapper_binary
6363
shell: bash
6464
run: |
65-
HLS_WRAPPER=$(find ../b \( -name 'haskell-language-server-wrapper' -o -name 'haskell-language-server-wrapper.exe' \) -type f)
65+
HLS_WRAPPER=$(find dist-newstyle \( -name 'hls-wrapper' -o -name 'hls-wrapper.exe' \) -type f)
6666
echo ::set-output name=hls_wrapper_binary::$HLS_WRAPPER
6767
6868
- name: Upload Wrapper

‎cabal.project‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -16,7 +16,7 @@ source-repository-package
1616
source-repository-package
1717
type: git
1818
location: https://github.com/bubba/hie-bios.git
19-
tag: c9411178
19+
tag: 6df34cb7df3d380a2ef245d4fe54c18ce6874f48
2020

2121
tests: true
2222
documentation: true

‎exe/Arguments.hs‎

Lines changed: 0 additions & 17 deletions
Original file line numberDiff line numberDiff line change
@@ -11,20 +11,13 @@ module Arguments
1111
( Arguments(..)
1212
, getArguments
1313
, ghcideVersion
14-
, getGhcLibDir
1514
) where
1615

17-
import Data.Char
18-
import Data.List
19-
import Data.Maybe
2016
import Data.Version
2117
import Development.GitRev
22-
import qualified GHC.Paths
23-
import HIE.Bios.Types
2418
import Options.Applicative
2519
import Paths_haskell_language_server
2620
import System.Environment
27-
import System.Process
2821

2922
-- ---------------------------------------------------------------------
3023

@@ -89,16 +82,6 @@ arguments exeName = Arguments
8982
<> help "Work out the project GHC version and print it")
9083

9184
-- ---------------------------------------------------------------------
92-
-- Set the GHC libdir to the nix libdir if it's present.
93-
getGhcLibDir :: ComponentOptions -> IO FilePath
94-
getGhcLibDir opts = do
95-
nixLibDir <- lookupEnv "NIX_GHC_LIBDIR"
96-
-- We want to avoid using ghc-paths, as it is not portable
97-
-- in the static binary sense - it just bakes in the path to the
98-
-- libraries at compile time! This is ok if the user built from
99-
-- source, but if they downloaoded a binary then this will return
100-
-- some path that doesn't exist on their computer.
101-
return $ fromMaybe GHC.Paths.libdir (nixLibDir <|> ghcLibDir opts)
10285

10386
ghcideVersion :: IO String
10487
ghcideVersion = do

‎exe/Main.hs‎

Lines changed: 33 additions & 19 deletions
Original file line numberDiff line numberDiff line change
@@ -1,6 +1,6 @@
11
-- Copyright (c) 2019 The DAML Authors. All rights reserved.
22
-- SPDX-License-Identifier: Apache-2.0
3-
{-# LANGUAGE CPP #-} -- To get precise GHC version
3+
{-# LANGUAGE CPP #-} -- To get precise GHC version and check if distributed binary
44
{-# LANGUAGE TemplateHaskell #-}
55
{-# OPTIONS_GHC -Wno-dodgy-imports #-} -- GHC no longer exports def in GHC 8.6 and above
66
{-# LANGUAGE DeriveGeneric #-}
@@ -58,7 +58,7 @@ import GHC hiding (def)
5858
import GHC.Check ( VersionCheck(..), makeGhcVersionChecker )
5959
-- import GhcMonad
6060
import HIE.Bios.Cradle
61-
import HIE.Bios.Environment (addCmdOpts, makeDynFlagsAbsolute)
61+
import HIE.Bios.Environment (addCmdOpts, makeDynFlagsAbsolute, getRuntimeGhcLibDir)
6262
import HIE.Bios.Types
6363
import HscTypes (HscEnv(..), ic_dflags)
6464
import qualified Language.Haskell.LSP.Core as LSP
@@ -316,10 +316,9 @@ loadSession dir = do
316316
-- If the hieYaml file already has an HscEnv, the new component is
317317
-- combined with the components in the old HscEnv into a new HscEnv
318318
-- which contains both.
319-
packageSetup <- return $ \(hieYaml, cfp, opts) -> do
319+
packageSetup <- return $ \(hieYaml, cfp, opts, libDir) -> do
320320
-- Parse DynFlags for the newly discovered component
321-
libdir <- getGhcLibDir opts
322-
hscEnv <- emptyHscEnv libdir nc
321+
hscEnv <- emptyHscEnv libDir nc
323322
(df, targets) <- evalGhcEnv hscEnv $ do
324323
setOptions opts (hsc_dflags hscEnv)
325324
dep_info <- getDependencyInfo (componentDependencies opts)
@@ -355,7 +354,7 @@ loadSession dir = do
355354
-- It's important to keep the same NameCache though for reasons
356355
-- that I do not fully understand
357356
print ("Making new HscEnv" ++ (show inplace))
358-
hscEnv <- emptyHscEnv libdir nc
357+
hscEnv <- emptyHscEnv libDir nc
359358
newHscEnv <-
360359
-- Add the options for the current component to the HscEnv
361360
evalGhcEnv hscEnv $ do
@@ -372,8 +371,8 @@ loadSession dir = do
372371
pure (Map.insert hieYaml (newHscEnv, new_deps) m, (newHscEnv, head new_deps', tail new_deps'))
373372

374373

375-
session <- return $ \(hieYaml, cfp, opts) -> do
376-
(hscEnv, new, old_deps) <- packageSetup (hieYaml, cfp, opts)
374+
session <- return $ \(hieYaml, cfp, opts, libDir) -> do
375+
(hscEnv, new, old_deps) <- packageSetup (hieYaml, cfp, opts, libDir)
377376
-- TODO Handle the case where there is no hie.yaml
378377
-- Make a map from unit-id to DynFlags, this is used when trying to
379378
-- resolve imports.
@@ -447,19 +446,34 @@ loadSession dir = do
447446
void $ forkIO $ do
448447
putStrLn $ "Consulting the cradle for " <> show file
449448
cradle <- maybe (loadImplicitCradle $ addTrailingPathSeparator dir) loadCradle hieYaml
449+
450+
-- we don't want to use ghc-paths if this is a portable, distributed binary
451+
mLibDir <- getRuntimeGhcLibDir cradle
452+
#ifdef DIST_BINARY
453+
True
454+
#else
455+
False
456+
#endif
457+
450458
eopts <- cradleToSessionOpts cradle cfp
451459
print eopts
452-
case eopts of
453-
Right opts -> do
454-
(cs, res) <- session (hieYaml, toNormalizedFilePath' cfp, opts)
460+
461+
let ncfp = toNormalizedFilePath' cfp
462+
cradleMishap diags = do
463+
dep_info <- getDependencyInfo ([fp | Just fp <- [hieYaml]])
464+
let res = (diags, Nothing)
465+
modifyVar_ fileToFlags $ \var -> do
466+
pure $ Map.insertWith HM.union hieYaml (HM.singleton ncfp (res, dep_info)) var
467+
signalBarrier finished_barrier ([(ncfp, (res, dep_info) )], res)
468+
469+
case (eopts, mLibDir) of
470+
(Right opts, Just libDir) -> do
471+
(cs, res) <- session (hieYaml, toNormalizedFilePath' cfp, opts, libDir)
455472
signalBarrier finished_barrier (cs, fst res)
456-
Left err -> do
457-
dep_info <- getDependencyInfo ([fp | Just fp <- [hieYaml]])
458-
let ncfp = toNormalizedFilePath' cfp
459-
let res = (map (renderCradleError ncfp) err, Nothing)
460-
modifyVar_ fileToFlags $ \var -> do
461-
pure $ Map.insertWith HM.union hieYaml (HM.singleton ncfp (res, dep_info)) var
462-
signalBarrier finished_barrier ([(ncfp, (res, dep_info) )], res)
473+
474+
(Left err, _) -> cradleMishap $ map (renderCradleError ncfp) err
475+
(_, Nothing) -> cradleMishap [ideErrorText ncfp "Couldn't get the GHC library directory"]
476+
463477
waitBarrier finished_barrier
464478

465479
dummyAs <- async $ return (error "Uninitialised")
@@ -615,7 +629,7 @@ memoIO op = do
615629
Just res -> return (mp, res)
616630

617631
setOptions :: GhcMonad m => ComponentOptions -> DynFlags -> m (DynFlags, [Target])
618-
setOptions (ComponentOptions theOpts compRoot _deps _mlibdir) dflags = do
632+
setOptions (ComponentOptions theOpts compRoot _deps) dflags = do
619633
(dflags_, targets) <- addCmdOpts theOpts dflags
620634
let dflags' = makeDynFlagsAbsolute compRoot dflags_
621635
let dflags'' =

‎exe/Wrapper.hs‎

Lines changed: 10 additions & 11 deletions
Original file line numberDiff line numberDiff line change
@@ -24,7 +24,6 @@ import Ide.Version
2424
import System.Directory
2525
import System.Environment
2626
import System.Exit
27-
import System.FilePath
2827
import System.IO
2928
import System.Info
3029
import System.Process
@@ -36,9 +35,17 @@ main = do
3635
-- WARNING: If you write to stdout before runLanguageServer
3736
-- then the language server will not work
3837
Arguments{..} <- getArguments "haskell-language-server-wrapper"
38+
39+
d <- getCurrentDirectory
40+
41+
-- Get the cabal directory from the cradle
42+
cradle <- findLocalCradle d
43+
let dir = cradleRootDir cradle
44+
setCurrentDirectory dir
45+
46+
ghcVersion <- getProjectGhcVersion cradle
3947

40-
when argsProjectGhcVersion $
41-
getCurrentDirectory >>= loadImplicitCradle >>= getProjectGhcVersion >>= putStrLn >> exitSuccess
48+
when argsProjectGhcVersion $ putStrLn ghcVersion >> exitSuccess
4249

4350
if argsVersion then ghcideVersion >>= putStrLn >> exitSuccess
4451
else hPutStrLn stderr {- see WARNING above -} =<< ghcideVersion
@@ -61,19 +68,11 @@ main = do
6168
progName <- getProgName
6269
logm $ "run entered for haskell-language-server-wrapper(" ++ progName ++ ") "
6370
++ hlsVersion
64-
d <- getCurrentDirectory
6571
logm $ "Current directory:" ++ d
6672
logm $ "Operating system:" ++ os
6773
args <- getArgs
6874
logm $ "args:" ++ show args
69-
70-
-- Get the cabal directory from the cradle
71-
cradle <- findLocalCradle d
72-
let dir = cradleRootDir cradle
7375
logm $ "Cradle directory:" ++ dir
74-
setCurrentDirectory dir
75-
76-
ghcVersion <- getProjectGhcVersion cradle
7776
logm $ "Project GHC version:" ++ ghcVersion
7877

7978
let

‎haskell-language-server.cabal‎

Lines changed: 15 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -26,17 +26,25 @@ flag pedantic
2626
Default: False
2727
Manual: True
2828

29+
flag dist-binary
30+
Description: Build haskell-language-server ready for distributing binaries
31+
Default: False
32+
Manual: True
33+
2934
source-repository head
3035
type: git
3136
location: https://github.com/haskell/haskell-language-server
3237

33-
common agpl
38+
common cpp-flags
3439
if flag(agpl)
3540
cpp-options:
3641
-DAGPL
42+
if flag(dist-binary)
43+
cpp-options:
44+
-DDIST_BINARY
3745

3846
library
39-
import: agpl
47+
import: cpp-flags
4048
exposed-modules:
4149
Ide.Cradle
4250
Ide.Logger
@@ -107,7 +115,7 @@ library
107115
default-language: Haskell2010
108116

109117
executable haskell-language-server
110-
import: agpl
118+
import: cpp-flags
111119
main-is: Main.hs
112120
hs-source-dirs:
113121
exe
@@ -169,8 +177,8 @@ executable haskell-language-server
169177
, unordered-containers
170178
default-language: Haskell2010
171179

172-
executable haskell-language-server-wrapper
173-
import: agpl
180+
executable hls-wrapper
181+
import: cpp-flags
174182
main-is: Wrapper.hs
175183
hs-source-dirs:
176184
exe
@@ -210,7 +218,7 @@ executable haskell-language-server-wrapper
210218
-- We removed it due to issues with stack when loading the project using a stack based hie.yaml
211219
-- See https://github.com/haskell/haskell-language-server/issues/114
212220
common hls-test-utils
213-
import: agpl
221+
import: cpp-flags
214222
hs-source-dirs: test/utils
215223
other-modules: Test.Hls.Util
216224
build-depends: base
@@ -238,7 +246,7 @@ common hls-test-utils
238246
default-language: Haskell2010
239247

240248
test-suite func-test
241-
import: agpl, hls-test-utils
249+
import: cpp-flags, hls-test-utils
242250
type: exitcode-stdio-1.0
243251
default-language: Haskell2010
244252
build-tool-depends: haskell-language-server:haskell-language-server

‎src/Ide/Cradle.hs‎

Lines changed: 10 additions & 18 deletions
Original file line numberDiff line numberDiff line change
@@ -54,7 +54,7 @@ findLocalCradle fp = do
5454
debugm $ "Found \"" ++ yaml ++ "\" for \"" ++ fp ++ "\""
5555
crdl <- Bios.loadCradle yaml
5656
return $ fmap (const CabalNone) crdl
57-
Nothing -> Bios.loadImplicitCradle fp -- cabalHelperCradle fp
57+
Nothing -> Bios.loadImplicitCradle (fp </> "Foo.hs") -- cabalHelperCradle fp
5858
logm $ "Module \"" ++ fp ++ "\" is loaded by Cradle: " ++ show crdl
5959
return crdl
6060

@@ -100,7 +100,7 @@ data CabalHelper
100100
execProjectGhc :: Cradle CabalHelper -> [String] -> IO (Maybe String)
101101
execProjectGhc crdl args = do
102102
isStackInstalled <- isJust <$> findExecutable "stack"
103-
-- isCabalInstalled <- isJust <$> findExecutable "cabal"
103+
isCabalInstalled <- isJust <$> findExecutable "cabal"
104104
ghcOutput <- if isStackCradle crdl && isStackInstalled
105105
then do
106106
logm $ "Executing Stack GHC with args: " <> unwords args
@@ -112,11 +112,11 @@ execProjectGhc crdl args = do
112112
-- This command must work though before the project is build.
113113
-- Therefore, fallback to "ghc" on the path.
114114
--
115-
-- else if isCabalCradle crdl && isCabalInstalled then do
116-
-- let cmd = "cabal v2-exec -v0 ghc -- " ++ unwords args
117-
-- catch (Just <$> tryCommand crdl cmd) $ \(_ ::IOException) -> do
118-
-- errorm $ "Command `" ++ cmd ++ "` failed."
119-
-- return Nothing
115+
else if isCabalCradle crdl && isCabalInstalled then do
116+
let cmd = "cabal v2-exec -v0 ghc -- " ++ unwords args
117+
catch (Just <$> tryCommand crdl cmd) $ \(_ ::IOException) -> do
118+
errorm $ "Command `" ++ cmd ++ "` failed."
119+
return Nothing
120120
else do
121121
logm $ "Executing GHC on path with args: " <> unwords args
122122
execWithGhc
@@ -153,15 +153,6 @@ tryCommand crdl cmd = do
153153
ExitSuccess -> return $ T.unpack . T.strip . head . T.lines $ T.pack sout
154154

155155

156-
-- | Get the directory of the libdir based on the project ghc.
157-
getProjectGhcLibDir :: Cradle CabalHelper -> IO (Maybe FilePath)
158-
getProjectGhcLibDir crdl =
159-
execProjectGhc crdl ["--print-libdir"] >>= \case
160-
Nothing -> do
161-
errorm "Could not obtain the libdir."
162-
return Nothing
163-
mlibdir -> return mlibdir
164-
165156
-- ---------------------------------------------------------------------
166157

167158

@@ -469,8 +460,8 @@ cabalHelperCradle file = do
469460
{ componentOptions = [file, fixImportDirs cwd "-i."]
470461
, componentRoot = cwd
471462
, componentDependencies = []
472-
, ghcLibDir = Nothing
473463
}
464+
, runGhcLibDir = pure Nothing
474465
}
475466
}
476467
Just (Ex proj) -> do
@@ -498,6 +489,7 @@ cabalHelperCradle file = do
498489
, cradleOptsProg =
499490
CradleAction { actionName = Bios.Other (projectNoneType proj)
500491
, runCradle = \_ _ -> return CradleNone
492+
, runGhcLibDir = pure Nothing
501493
}
502494
}
503495
Just realPackage -> do
@@ -518,6 +510,7 @@ cabalHelperCradle file = do
518510
realPackage
519511
normalisedPackageLocation
520512
fp
513+
, runGhcLibDir = pure Nothing
521514
}
522515
}
523516

@@ -555,7 +548,6 @@ cabalHelperAction proj env package root fp = do
555548
ComponentOptions { componentOptions = ghcOptions
556549
, componentRoot = root
557550
, componentDependencies = []
558-
, ghcLibDir = Nothing
559551
}
560552
Left err -> return
561553
$ CradleFail

0 commit comments

Comments
 (0)