Compare commits

..

15 Commits

Author SHA1 Message Date
13e01ab453 Fix hlint warnings 2022-07-07 15:05:51 +02:00
873dd77a6f Fix build on windows 2022-07-07 15:05:51 +02:00
544c618473 Don't remove legacy dir if it doesn't exist 2022-07-07 14:03:49 +02:00
a264cb088e Improve 'ghcup compile hls'
1. short hashes now work
2. print the long hash in addition to the detected cabal version of HLS
3. add `--git-describe-version` switch as an alternative to
   `--overwrite-version`

Fix 1. and 2. for GHC as well.
2022-07-06 22:49:11 +02:00
1a43fddca9 Improve about docs 2022-07-02 20:34:19 +02:00
bdfb1a3a9b Merge remote-tracking branch 'origin/merge-requests/264' 2022-06-26 23:14:36 +02:00
9b8b3e8126 Merge remote-tracking branch 'origin/merge-requests/263' 2022-06-26 23:14:10 +02:00
d657c17df4 Merge branch 'issue-375' 2022-06-26 23:11:32 +02:00
why-not-try-calmer
e143c06697 VSCode integration
Typo
2022-06-16 11:07:12 +02:00
Jens Petersen
29da21f5dc bootstrap-haskell: s/will download/can download/
A one word tweak to weaken the language in the initial explanation
to make it "less scary": in general ghcup does not always download
all of ghcup, ghc, cabal, stack, and hls
(unless requested or they are not already installed, etc),
but "will download" sounds like the user is has no choice here
except to always download everything,
which might give them second thoughts about trying this script
and hence adopting ghcup.

Perhaps the wording could be made further more precise,
but at least "can" gives one less anxiety.
2022-06-11 13:06:54 +08:00
028696d4be Merge branch 'issue-377' 2022-06-09 15:29:01 +02:00
4022edb12e Allow passing bindist configure args wrt #377 2022-06-09 14:42:01 +02:00
fde5044194 Merge branch 'issue-371' 2022-06-07 18:44:31 +02:00
3af1286ab7 Fix ghcup_bootstrap test 2022-06-07 17:49:33 +02:00
bcff46d3d4 Fix mingw PATH handling wrt #371 2022-06-07 14:37:23 +02:00
14 changed files with 207 additions and 76 deletions

View File

@@ -449,7 +449,7 @@ install' _ (_, ListResult {..}) = do
case lTool of
GHC -> do
let vi = getVersionInfo lVer GHC dls
liftE $ installGHCBin lVer GHCupInternal False $> (vi, dirs, ce)
liftE $ installGHCBin lVer GHCupInternal False [] $> (vi, dirs, ce)
Cabal -> do
let vi = getVersionInfo lVer Cabal dls
liftE $ installCabalBin lVer GHCupInternal False $> (vi, dirs, ce)

View File

@@ -82,7 +82,7 @@ data HLSCompileOptions = HLSCompileOptions
{ targetHLS :: Either Version GitBranch
, jobs :: Maybe Int
, setCompile :: Bool
, ovewrwiteVer :: Maybe Version
, ovewrwiteVer :: Either Bool Version
, isolateDir :: Maybe FilePath
, cabalProject :: Maybe (Either FilePath URI)
, cabalProjectLocal :: Maybe URI
@@ -145,14 +145,16 @@ Examples:
compileHLSFooter = [s|Discussion:
Compiles and installs the specified HLS version.
The last argument is a list of GHC versions to compile for.
The --ghc arguments are necessary to specify which GHC version to build for/against.
These need to be available in PATH prior to compilation.
Examples:
# compile 1.4.0 for ghc 8.10.5 and 8.10.7
ghcup compile hls -v 1.4.0 -j 12 --ghc 8.10.5 --ghc 8.10.7
# compile from master for ghc 8.10.7, linking everything dynamically
ghcup compile hls -g master -j 12 --ghc 8.10.7 -- --ghc-options='-dynamic'|]
# compile 1.7.0.0 for ghc 8.10.5 and 8.10.7, passing '--allow-newer' to cabal
ghcup compile hls -v 1.7.0.0 -j 12 --ghc 8.10.5 --ghc 8.10.7 -- --allow-newer
# compile from master for ghc 9.2.3 and use 'git describe' to name the binary
ghcup compile hls -g master --git-describe-version --ghc 9.2.3
# compile a specific commit for ghc 9.2.3 and set a specifc version for the binary name
ghcup compile hls -g a32db0b -o 1.7.0.0-p1 --ghc 9.2.3|]
ghcCompileOpts :: Parser GHCCompileOptions
@@ -232,7 +234,7 @@ ghcCompileOpts =
"Build cross-compiler for this platform"
)
)
<*> many (argument str (metavar "CONFIGURE_ARGS" <> help "Additional arguments to configure, prefix with '-- ' (longopts)"))
<*> many (argument str (metavar "CONFIGURE_ARGS" <> help "Additional arguments to compile configure, prefix with '-- ' (longopts)"))
<*> fmap (fromMaybe False) (invertableSwitch "set" Nothing False (help "Set as active version after install"))
<*> optional
(option
@@ -280,7 +282,7 @@ hlsCompileOpts =
(Right <$> (GitBranch <$> option
str
(short 'g' <> long "git-ref" <> metavar "GIT_REFERENCE" <> help
"The git commit/branch/ref to build from"
"The git commit/branch/ref to build from (accepts anything 'git checkout' accepts)"
) <*>
optional (option str (short 'r' <> long "repository" <> metavar "GIT_REPOSITORY" <> help "The git repository to build from (defaults to HLS upstream)"
<> completer (gitFileUri ["https://github.com/haskell/haskell-language-server.git"])
@@ -295,8 +297,9 @@ hlsCompileOpts =
)
)
<*> fmap (fromMaybe True) (invertableSwitch "set" Nothing True (help "Don't set as active version after install"))
<*> optional
(option
<*>
(
(Right <$> option
(eitherReader
(first (const "Not a valid version") . version . T.pack)
)
@@ -305,6 +308,14 @@ hlsCompileOpts =
<> (completer $ versionCompleter Nothing HLS)
)
)
<|>
(Left <$> (switch
(long "git-describe-version"
<> help "Use the output of 'git describe' (if building from git) as the VERSION component of the installed binary."
)
)
)
)
<*> optional
(option
(eitherReader isolateParser)

View File

@@ -71,6 +71,7 @@ data InstallOptions = InstallOptions
, instSet :: Bool
, isolateDir :: Maybe FilePath
, forceInstall :: Bool
, addConfArgs :: [T.Text]
}
@@ -213,6 +214,7 @@ installOpts tool =
)
<*> switch
(short 'f' <> long "force" <> help "Force install (THIS IS UNSAFE, only use it in Dockerfiles or CI)")
<*> many (argument str (metavar "CONFIGURE_ARGS" <> help "Additional arguments to bindist configure, prefix with '-- ' (longopts)"))
where
setDefault = case tool of
Nothing -> False
@@ -335,6 +337,7 @@ install installCommand settings getAppState' runLogger = case installCommand of
(_tvVersion v)
(maybe GHCupInternal IsolateDir isolateDir)
forceInstall
addConfArgs
)
$ when instSet $ when (isNothing isolateDir) $ liftE $ void $ setGHC v SetGHCOnly Nothing
pure vi
@@ -346,6 +349,7 @@ install installCommand settings getAppState' runLogger = case installCommand of
(_tvVersion v)
(maybe GHCupInternal IsolateDir isolateDir)
forceInstall
addConfArgs
)
$ when instSet $ when (isNothing isolateDir) $ liftE $ void $ setGHC v SetGHCOnly Nothing
pure vi

View File

@@ -361,6 +361,7 @@ run RunOptions{..} runAppState leanAppstate runLogger = do
(_tvVersion v)
GHCupInternal
False
[]
setTool GHC v tmp
Just (Cabal, v) -> do
unless isInstalled $ when runInstTool' $ void $ liftE $ installCabalBin

View File

@@ -340,7 +340,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
(GHC, ver) = cmp' GHC (Just $ ToolVersion (mkTVer over)) ver
alreadyInstalling (Compile (CompileGHC GHCCompileOptions{ targetGhc = Left tver }))
(GHC, ver) = cmp' GHC (Just $ ToolVersion (mkTVer tver)) ver
alreadyInstalling (Compile (CompileHLS HLSCompileOptions{ ovewrwiteVer = Just over }))
alreadyInstalling (Compile (CompileHLS HLSCompileOptions{ ovewrwiteVer = Right over }))
(HLS, ver) = cmp' HLS (Just $ ToolVersion (mkTVer over)) ver
alreadyInstalling (Compile (CompileHLS HLSCompileOptions{ targetHLS = Left tver }))
(HLS, ver) = cmp' HLS (Just $ ToolVersion (mkTVer tver)) ver

View File

@@ -74,12 +74,15 @@ cabal-install/HLS/stack are installed in `~/.ghcup/bin/<tool>-<ver>` and have un
## Known users
* Github actions:
- [actions/virtual-environments](https://github.com/actions/virtual-environments)
- [haskell/actions/setup](https://github.com/haskell/actions/tree/main/setup)
* CI:
- [Github actions/virtual-environments](https://github.com/actions/virtual-environments)
- [Github haskell/actions/setup](https://github.com/haskell/actions/tree/main/setup)
- [haskell-ci](https://github.com/haskell-CI/haskell-ci)
* mirrors:
- [sjtug](https://mirror.sjtu.edu.cn/docs/ghcup)
* tools:
- [vscode-haskell](https://github.com/haskell/vscode-haskell)
- [nvim-lsp-installer](https://github.com/williamboman/nvim-lsp-installer)
- [vabal](https://github.com/Franciman/vabal)
## Known problems

View File

@@ -200,6 +200,14 @@ export PATH="$HOME/.cabal/bin:$HOME/.ghcup/bin:$PATH"
See [ghcup.vim](https://github.com/hasufell/ghcup.vim).
## VSCode integration
The developers of the Haskell Language Server offer an [extension](https://github.com/haskell/vscode-haskell) tightly integrated with the [Haskell Language Server](https://github.com/haskell/haskell-language-server). To get started:
1. Install GHCup. During installation, opt in to install the Haskell Language Server (HLS).
2. Install the extension (from VSCode: Ctrl + P and then `ext install haskell.haskell`).
3. Make sure your project uses the GHC version installed from GHCup (otherwise HLS is likely to fail on launch):
- instructions for [stack](https://docs.haskellstack.org/en/stable/yaml_configuration/#system-ghc)
## Get help
* [Libera IRC chat on #haskell-ghcup or #haskell](https://kiwiirc.com/nextclient/irc.libera.chat/?nick=Guest%7C?#haskell,#haskell-ghcup)

View File

@@ -164,8 +164,10 @@ library
cpp-options: -DIS_WINDOWS
other-modules:
GHCup.Prelude.File.Windows
GHCup.Prelude.Process.Windows
GHCup.Prelude.Windows
-- GHCup.OptParse.Run uses this
exposed-modules:
GHCup.Prelude.Process.Windows
build-depends:
, bzlib

View File

@@ -141,6 +141,7 @@ installGHCBindist :: ( MonadFail m
-> Version -- ^ the version to install
-> InstallDir
-> Bool -- ^ Force install
-> [T.Text] -- ^ additional configure args for bindist
-> Excepts
'[ AlreadyInstalled
, BuildFailed
@@ -159,7 +160,7 @@ installGHCBindist :: ( MonadFail m
]
m
()
installGHCBindist dlinfo ver installDir forceInstall = do
installGHCBindist dlinfo ver installDir forceInstall addConfArgs = do
let tver = mkTVer ver
lift $ logDebug $ "Requested to install GHC with " <> prettyVer ver
@@ -189,12 +190,12 @@ installGHCBindist dlinfo ver installDir forceInstall = do
case installDir of
IsolateDir isoDir -> do -- isolated install
lift $ logInfo $ "isolated installing GHC to " <> T.pack isoDir
liftE $ installPackedGHC dl (view dlSubdir dlinfo) (IsolateDirResolved isoDir) ver forceInstall
liftE $ installPackedGHC dl (view dlSubdir dlinfo) (IsolateDirResolved isoDir) ver forceInstall addConfArgs
GHCupInternal -> do -- regular install
-- prepare paths
ghcdir <- lift $ ghcupGHCDir tver
liftE $ installPackedGHC dl (view dlSubdir dlinfo) (GHCupDir ghcdir) ver forceInstall
liftE $ installPackedGHC dl (view dlSubdir dlinfo) (GHCupDir ghcdir) ver forceInstall addConfArgs
-- make symlinks & stuff when regular install,
liftE $ postGHCInstall tver
@@ -230,6 +231,7 @@ installPackedGHC :: ( MonadMask m
-> InstallDirResolved
-> Version -- ^ The GHC version
-> Bool -- ^ Force install
-> [T.Text] -- ^ additional configure args for bindist
-> Excepts
'[ BuildFailed
, UnknownArchive
@@ -239,7 +241,7 @@ installPackedGHC :: ( MonadMask m
, ProcessError
, MergeFileTreeError
] m ()
installPackedGHC dl msubdir inst ver forceInstall = do
installPackedGHC dl msubdir inst ver forceInstall addConfArgs = do
PlatformRequest {..} <- lift getPlatformReq
unless forceInstall
@@ -256,7 +258,7 @@ installPackedGHC dl msubdir inst ver forceInstall = do
msubdir
liftE $ runBuildAction tmpUnpack
(installUnpackedGHC workdir inst ver forceInstall)
(installUnpackedGHC workdir inst ver forceInstall addConfArgs)
-- | Install an unpacked GHC distribution. This only deals with the GHC
@@ -277,8 +279,9 @@ installUnpackedGHC :: ( MonadReader env m
-> InstallDirResolved -- ^ Path to install to
-> Version -- ^ The GHC version
-> Bool -- ^ Force install
-> [T.Text] -- ^ additional configure args for bindist
-> Excepts '[ProcessError, MergeFileTreeError] m ()
installUnpackedGHC path inst ver forceInstall
installUnpackedGHC path inst ver forceInstall addConfArgs
| isWindows = do
lift $ logInfo "Installing GHC (this may take a while)"
-- Windows bindists are relocatable and don't need
@@ -301,7 +304,7 @@ installUnpackedGHC path inst ver forceInstall
lift $ logInfo "Installing GHC (this may take a while)"
lEM $ execLogged "sh"
("./configure" : ("--prefix=" <> fromInstallDir inst)
: alpineArgs
: (alpineArgs <> (T.unpack <$> addConfArgs))
)
(Just $ fromGHCupPath path)
"ghc-configure"
@@ -342,6 +345,7 @@ installGHCBin :: ( MonadFail m
=> Version -- ^ the version to install
-> InstallDir
-> Bool -- ^ force install
-> [T.Text] -- ^ additional configure args for bindist
-> Excepts
'[ AlreadyInstalled
, BuildFailed
@@ -360,9 +364,9 @@ installGHCBin :: ( MonadFail m
]
m
()
installGHCBin ver installDir forceInstall = do
installGHCBin ver installDir forceInstall addConfArgs = do
dlinfo <- liftE $ getDownloadInfo GHC ver
liftE $ installGHCBindist dlinfo ver installDir forceInstall
liftE $ installGHCBindist dlinfo ver installDir forceInstall addConfArgs
@@ -562,8 +566,11 @@ rmGHCVer ver = do
lift $ recycleFile f
when (not (null survivors)) $ throwE $ UninstallFailed dir survivors
Nothing -> do
lift $ logInfo $ "Removing legacy directory recursively: " <> T.pack dir
lift $ recyclePathForcibly dir'
isDir <- liftIO $ doesDirectoryExist dir
isSyml <- liftIO $ handleIO (\_ -> pure False) $ pathIsSymbolicLink dir
when (isDir && not isSyml) $ do
lift $ logInfo $ "Removing legacy directory recursively: " <> T.pack dir
recyclePathForcibly dir'
v' <-
handle
@@ -677,28 +684,53 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patches aargs buildFlavour hadr
, "origin"
, fromString rep ]
let fetch_args =
[ "fetch"
, "--depth"
, "1"
, "--quiet"
, "origin"
, fromString ref ]
-- figure out if we can do a shallow clone
remoteBranches <- catchE @ProcessError @'[PatchFailed, ProcessError, NotFoundInPATH, DigestError, DownloadFailed, GPGError] @'[PatchFailed, NotFoundInPATH, DigestError, DownloadFailed, GPGError] (\(_ :: ProcessError) -> pure [])
$ fmap processBranches $ gitOut ["ls-remote", "--heads", "origin"] (fromGHCupPath tmpUnpack)
let shallow_clone
| isCommitHash ref = True
| fromString ref `elem` remoteBranches = True
| otherwise = False
lift $ logDebug $ "Shallow clone: " <> T.pack (show shallow_clone)
-- fetch
let fetch_args
| shallow_clone = ["fetch", "--depth", "1", "--quiet", "origin", fromString ref]
| otherwise = ["fetch", "--tags", "--quiet", "origin" ]
lEM $ git fetch_args
lEM $ git [ "checkout", "FETCH_HEAD" ]
-- initial checkout
lEM $ git [ "checkout", fromString ref ]
-- gather some info
git_describe <- if shallow_clone
then pure Nothing
else fmap Just $ liftE $ gitOut ["describe", "--tags"] (fromGHCupPath tmpUnpack)
chash <- liftE $ gitOut ["rev-parse", "HEAD" ] (fromGHCupPath tmpUnpack)
-- clone submodules
lEM $ git [ "submodule", "update", "--init", "--depth", "1" ]
-- apply patches
liftE $ applyAnyPatch patches (fromGHCupPath tmpUnpack)
-- bootstrap
lEM $ execWithGhcEnv "python3" ["./boot"] (Just $ fromGHCupPath tmpUnpack) "ghc-bootstrap"
lEM $ execWithGhcEnv "sh" ["./configure"] (Just $ fromGHCupPath tmpUnpack) "ghc-bootstrap"
CapturedProcess {..} <- lift $ makeOut
["show!", "--quiet", "VALUE=ProjectVersion" ] (Just $ fromGHCupPath tmpUnpack)
case _exitCode of
ExitSuccess -> throwEither . MP.parse ghcProjectVersion "" . decUTF8Safe' $ _stdOut
tver <- case _exitCode of
ExitSuccess -> throwEither . MP.parse ghcProjectVersion "" . T.pack . stripNewlineEnd . T.unpack . decUTF8Safe' $ _stdOut
ExitFailure c -> fail ("Could not figure out GHC project version. Exit code was: " <> show c <> ". Error was: " <> T.unpack (decUTF8Safe' _stdErr))
liftE $ catchWarn $ lEM @_ @'[ProcessError] $ darwinNotarization _rPlatform (fromGHCupPath tmpUnpack)
lift $ logInfo $ "Git version " <> T.pack ref <> " corresponds to GHC version " <> prettyVer tver
liftE $ catchWarn $ lEM @_ @'[ProcessError] $ darwinNotarization _rPlatform (fromGHCupPath tmpUnpack)
lift $ logInfo $ "Examining git ref " <> T.pack ref <> "\n " <>
"GHC version (from Makefile): " <> prettyVer tver <>
(if not shallow_clone then "\n " <> "'git describe' output: " <> fromJust git_describe else mempty) <>
(if isCommitHash ref then mempty else "\n " <> "commit hash: " <> chash)
liftIO $ threadDelay 5000000 -- give the user a sec to intervene
pure tver
pure (tmpUnpack, tmpUnpack, GHCTargetVersion Nothing tver)
-- the version that's installed may differ from the
@@ -747,6 +779,7 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patches aargs buildFlavour hadr
ghcdir
(installVer ^. tvVersion)
False -- not a force install, since we already overwrite when compiling.
[]
liftIO $ B.writeFile (fromInstallDir ghcdir </> ghcUpSrcBuiltFile) bmk

View File

@@ -327,7 +327,7 @@ compileHLS :: ( MonadMask m
=> Either Version GitBranch
-> [Version]
-> Maybe Int
-> Maybe Version
-> Either Bool Version
-> InstallDir
-> Maybe (Either FilePath URI)
-> Maybe URI
@@ -349,7 +349,7 @@ compileHLS targetHLS ghcs jobs ov installDir cabalProject cabalProjectLocal patc
Dirs { .. } <- lift getDirs
(workdir, tver) <- case targetHLS of
(workdir, tver, git_describe) <- case targetHLS of
-- unpack from version tarball
Left tver -> do
lift $ logDebug $ "Requested to compile: " <> prettyVer tver
@@ -369,13 +369,13 @@ compileHLS targetHLS ghcs jobs ov installDir cabalProject cabalProjectLocal patc
(liftE . intoSubdir tmpUnpack)
(view dlSubdir dlInfo)
pure (workdir, tver)
pure (workdir, tver, Nothing)
-- clone from git
Right GitBranch{..} -> do
tmpUnpack <- lift mkGhcupTmpDir
let git args = execLogged "git" ("--no-pager":args) (Just $ fromGHCupPath tmpUnpack) "git" Nothing
tver <- reThrowAll @_ @'[ProcessError] DownloadFailed $ do
reThrowAll @_ @'[ProcessError] DownloadFailed $ do
let rep = fromMaybe "https://github.com/haskell/haskell-language-server.git" repo
lift $ logInfo $ "Fetching git repo " <> T.pack rep <> " at ref " <> T.pack ref <> " (this may take a while)"
lEM $ git [ "init" ]
@@ -384,33 +384,61 @@ compileHLS targetHLS ghcs jobs ov installDir cabalProject cabalProjectLocal patc
, "origin"
, fromString rep ]
let fetch_args =
[ "fetch"
, "--depth"
, "1"
, "--quiet"
, "origin"
, fromString ref ]
-- figure out if we can do a shallow clone
remoteBranches <- catchE @ProcessError @'[ProcessError] @'[] (\_ -> pure [])
$ fmap processBranches $ gitOut ["ls-remote", "--heads", "origin"] (fromGHCupPath tmpUnpack)
let shallow_clone
| gitDescribeRequested = False
| isCommitHash ref = True
| fromString ref `elem` remoteBranches = True
| otherwise = False
lift $ logDebug $ "Shallow clone: " <> T.pack (show shallow_clone)
-- fetch
let fetch_args
| shallow_clone = ["fetch", "--depth", "1", "--quiet", "origin", fromString ref]
| otherwise = ["fetch", "--tags", "--quiet", "origin" ]
lEM $ git fetch_args
lEM $ git [ "checkout", "FETCH_HEAD" ]
(Just gpd) <- parseGenericPackageDescriptionMaybe <$> liftIO (B.readFile (fromGHCupPath tmpUnpack </> "haskell-language-server.cabal"))
pure . (\c -> Version Nothing c [] Nothing)
. NE.fromList . fmap (NE.fromList . (:[]) . digits . fromIntegral)
. versionNumbers
. pkgVersion
. package
. packageDescription
$ gpd
-- checkout
lEM $ git [ "checkout", fromString ref ]
liftE $ catchWarn $ lEM @_ @'[ProcessError] $ darwinNotarization _rPlatform (fromGHCupPath tmpUnpack)
lift $ logInfo $ "Git version " <> T.pack ref <> " corresponds to HLS version " <> prettyVer tver
-- gather some info
git_describe <- if shallow_clone
then pure Nothing
else fmap Just $ gitOut ["describe", "--tags"] (fromGHCupPath tmpUnpack)
chash <- gitOut ["rev-parse", "HEAD" ] (fromGHCupPath tmpUnpack)
(Just gpd) <- parseGenericPackageDescriptionMaybe
<$> liftIO (B.readFile (fromGHCupPath tmpUnpack </> "haskell-language-server.cabal"))
let tver = (\c -> Version Nothing c [] Nothing)
. NE.fromList . fmap (NE.fromList . (:[]) . digits . fromIntegral)
. versionNumbers
. pkgVersion
. package
. packageDescription
$ gpd
pure (tmpUnpack, tver)
liftE $ catchWarn $ lEM @_ @'[ProcessError] $ darwinNotarization _rPlatform (fromGHCupPath tmpUnpack)
lift $ logInfo $ "Examining git ref " <> T.pack ref <> "\n " <>
"HLS version (from cabal file): " <> prettyVer tver <>
(if not shallow_clone then "\n " <> "'git describe' output: " <> fromJust git_describe else mempty) <>
(if isCommitHash ref then mempty else "\n " <> "commit hash: " <> chash)
pure (tmpUnpack, tver, git_describe)
-- the version that's installed may differ from the
-- compiled version, so the user can overwrite it
let installVer = fromMaybe tver ov
installVer <- case ov of
Left True -> case git_describe of
-- git describe
Just h -> either (fail . displayException) pure . version $ h
-- git describe, but not building from git, lol
Nothing -> pure tver
-- default: use detected version
Left False -> pure tver
-- overwrite version with users value
Right v -> pure v
liftE $ runBuildAction
workdir
@@ -464,7 +492,7 @@ compileHLS targetHLS ghcs jobs ov installDir cabalProject cabalProjectLocal patc
pure ghcInstallDir
forM_ artifacts $ \artifact -> do
logInfo $ T.pack (show artifact)
logDebug $ T.pack (show artifact)
liftIO $ renameFile (artifact </> "haskell-language-server" <.> exeExt)
(tmpInstallDir </> "haskell-language-server-" <> takeFileName artifact <.> exeExt)
liftIO $ renameFile (artifact </> "haskell-language-server-wrapper" <.> exeExt)
@@ -479,6 +507,10 @@ compileHLS targetHLS ghcs jobs ov installDir cabalProject cabalProjectLocal patc
)
pure installVer
where
gitDescribeRequested = case ov of
Left b -> b
_ -> False
-----------------
@@ -614,8 +646,11 @@ rmHLSVer ver = do
lift $ recycleFile f
when (not (null survivors)) $ throwE $ UninstallFailed hlsDir survivors
Nothing -> do
lift $ logInfo $ "Removing legacy directory recursively: " <> T.pack hlsDir
recyclePathForcibly hlsDir'
isDir <- liftIO $ doesDirectoryExist hlsDir
isSyml <- liftIO $ handleIO (\_ -> pure False) $ pathIsSymbolicLink hlsDir
when (isDir && not isSyml) $ do
lift $ logInfo $ "Removing legacy directory recursively: " <> T.pack hlsDir
recyclePathForcibly hlsDir'
when (Just ver == isHlsSet) $ do
-- set latest hls

View File

@@ -211,8 +211,8 @@ exec exe args chdir env = do
let paths = ["PATH", "Path"]
curPaths = (\x -> maybe [] splitSearchPath (Map.lookup x cEnv)) =<< paths
newPath = intercalate [searchPathSeparator] curPaths
setEnv "PATH" ""
setEnv "Path" newPath
liftIO $ setEnv "PATH" ""
liftIO $ setEnv "Path" newPath
cp <- createProcessWithMingwPath ((proc exe args) { cwd = chdir, env = env })
exit_code <- liftIO $ withCreateProcess cp $ \_ _ _ p -> waitForProcess p
pure $ toProcessError exe args exit_code
@@ -230,8 +230,8 @@ execNoMinGW exe args chdir env = do
let paths = ["PATH", "Path"]
curPaths = (\x -> maybe [] splitSearchPath (Map.lookup x cEnv)) =<< paths
newPath = intercalate [searchPathSeparator] curPaths
setEnv "PATH" ""
setEnv "Path" newPath
liftIO $ setEnv "PATH" ""
liftIO $ setEnv "Path" newPath
let cp = (proc exe args) { cwd = chdir, env = env }
exit_code <- liftIO $ withCreateProcess cp $ \_ _ _ p -> waitForProcess p
pure $ toProcessError exe args exit_code
@@ -257,8 +257,9 @@ createProcessWithMingwPath :: MonadIO m
createProcessWithMingwPath cp = do
msys2Dir <- liftIO ghcupMsys2Dir
cEnv <- Map.fromList <$> maybe (liftIO getEnvironment) pure (env cp)
let mingWPaths = [msys2Dir </> "usr" </> "bin"
,msys2Dir </> "mingw64" </> "bin"]
let mingWPaths = [msys2Dir </> "mingw64" </> "bin"
,msys2Dir </> "usr" </> "bin"
]
paths = ["PATH", "Path"]
curPaths = (\x -> maybe [] splitSearchPath (Map.lookup x cEnv)) =<< paths
newPath = intercalate [searchPathSeparator] (mingWPaths ++ curPaths)

View File

@@ -61,6 +61,7 @@ import Control.Monad.Reader
import Control.Monad.Trans.Resource
hiding ( throwM )
import Control.Monad.IO.Unlift ( MonadUnliftIO( withRunInIO ) )
import Data.Char ( isHexDigit )
import Data.Bifunctor ( first )
import Data.ByteString ( ByteString )
import Data.Either
@@ -1275,3 +1276,35 @@ warnAboutHlsCompatibility = do
T.pack (prettyShow supportedGHC)
_ -> return ()
-----------
--[ Git ]--
-----------
isCommitHash :: String -> Bool
isCommitHash str' = let hex = all isHexDigit str'
len = length str'
in hex && len == 40
gitOut :: (MonadReader env m, HasLog env, MonadIO m) => [String] -> FilePath -> Excepts '[ProcessError] m T.Text
gitOut args dir = do
CapturedProcess {..} <- lift $ executeOut "git" args (Just dir)
case _exitCode of
ExitSuccess -> pure $ T.pack $ stripNewlineEnd $ T.unpack $ decUTF8Safe' _stdOut
ExitFailure c -> do
let pe = NonZeroExit c "git" args
lift $ logDebug $ T.pack (prettyShow pe)
throwE pe
processBranches :: T.Text -> [String]
processBranches str' = let lines' = lines (T.unpack str')
words' = fmap words lines'
refs = catMaybes $ fmap (`atMay` 1) words'
branches = catMaybes $ fmap (stripPrefix "refs/heads/") $ filter (isPrefixOf "refs/heads/") refs
in branches

View File

@@ -546,7 +546,7 @@ adjust_cabal_config() {
else
cabal_bin="$HOME/AppData/Roaming/cabal/bin"
fi
ecabal user-config -a "extra-prog-path: $(cygpath -w "$GHCUP_BIN"), $(cygpath -w "$cabal_bin"), $(cygpath -w "$GHCUP_MSYS2"/usr/bin), $(cygpath -w "$GHCUP_MSYS2"/mingw64/bin)" -a "extra-include-dirs: $(cygpath -w "$GHCUP_MSYS2"/mingw64/include)" -a "extra-lib-dirs: $(cygpath -w "$GHCUP_MSYS2"/mingw64/lib)" -f init
ecabal user-config -a "extra-prog-path: $(cygpath -w "$GHCUP_BIN"), $(cygpath -w "$cabal_bin"), $(cygpath -w "$GHCUP_MSYS2"/mingw64/bin), $(cygpath -w "$GHCUP_MSYS2"/usr/bin)" -a "extra-include-dirs: $(cygpath -w "$GHCUP_MSYS2"/mingw64/include)" -a "extra-lib-dirs: $(cygpath -w "$GHCUP_MSYS2"/mingw64/lib)" -f init
}
ask_cabal_config_init() {
@@ -697,7 +697,7 @@ find_shell
echo
echo "Welcome to Haskell!"
echo
echo "This script will download and install the following binaries:"
echo "This script can download and install the following binaries:"
echo " * ghcup - The Haskell toolchain installer"
echo " * ghc - The Glasgow Haskell Compiler"
echo " * cabal - The Cabal build tool for managing Haskell software"
@@ -772,7 +772,7 @@ if [ -z "${BOOTSTRAP_HASKELL_MINIMAL}" ] ; then
do_cabal_config_init $ask_cabal_config_init_answer
ecabal update --ignore-project
edo cabal update --ignore-project
else # don't install ghc and cabal
case "${plat}" in
MSYS*|MINGW*)

View File

@@ -242,7 +242,7 @@ if ($Silent -and !($InstallDir)) {
Print-Msg -color Magenta -msg (@'
Welcome to Haskell!
This script will download and install the following programs:
This script can download and install the following programs:
* ghcup - The Haskell toolchain installer
* ghc - The Glasgow Haskell Compiler
* msys2 - A linux-style toolchain environment required for many operations