Compare commits

..

27 Commits

Author SHA1 Message Date
a6a54f34cf Merge branch 'issue-360' 2022-05-11 20:35:56 +02:00
f7811961b5 Merge branch 'isolateDir' 2022-05-11 20:35:38 +02:00
ee778e1177 Print bindir 2022-05-11 20:13:24 +02:00
5787a662ed Add a --quick switch to 'ghcup run'
Also fixes #360, because we resolve all tags/versions now
by default.
2022-05-11 20:11:35 +02:00
fce654f3c7 Update CHANGELOG 2022-05-11 16:21:37 +02:00
0f052c3465 Merge branch 'reenable-upgrade' 2022-05-11 16:20:28 +02:00
c733810fdc Bump version to 0.1.17.8 2022-05-11 16:19:34 +02:00
5130cb013b Fix HLS not cleaning up after failed install, fix #361 2022-05-11 16:18:35 +02:00
991e540c11 Refactor code around isolateDirs, so we have proper knowledge 2022-05-11 16:18:35 +02:00
a34d9b7b89 Fix type in bootstrap-haskell.ps1 2022-05-09 12:41:54 +02:00
4e62f559fa Update stackage resolver 2022-05-09 12:40:42 +02:00
8c3d2b6740 Merge branch 'improve-pwsh' 2022-05-04 16:05:00 +02:00
b6779f4d75 Improve welcome message in powershell installer
And warn about antivirus, fixes #343
2022-05-04 14:45:05 +02:00
b036c9861f Re-enable upgrade functionality for all configurations
Adds a --fail-if-shadowed switch.
2022-05-04 14:15:17 +02:00
02cd773c2a Update supported tools table 2022-05-03 11:40:05 +02:00
3964d06f5d Merge remote-tracking branch 'origin/merge-requests/249' 2022-05-02 19:06:48 +02:00
Nick Suchecki
e83612a06c Fix typo in compile hls --help subcommand. 2022-05-01 15:12:39 +00:00
cf6c666b59 Add credits to first step guide 2022-04-30 12:50:34 +02:00
ee0ec370c7 Add playground link 2022-04-29 18:55:45 +02:00
ea0e35ddf0 Merge branch 'issue-353' 2022-04-29 16:47:37 +02:00
99c8501d47 Silence hlint 2022-04-29 16:47:11 +02:00
f8a1fed1f2 Fix parsing of symlinks with multiple slashes,
Fixes #353
2022-04-29 19:22:16 +08:00
9ad1f7cb97 Update changelog 2022-04-21 23:38:58 +02:00
0856a96738 Bump ghcup in bootstrap-script 2022-04-21 23:02:30 +02:00
ee9801a8c2 Add GHCUP_BASE_URL env var for bootstrap-haskell 2022-04-18 13:22:20 +02:00
cfecc11b43 Bump version to 0.1.17.7 2022-04-16 06:42:01 +02:00
3d36348563 Merge branch 'issue-345' 2022-04-16 06:40:08 +02:00
20 changed files with 344 additions and 264 deletions

View File

@@ -176,6 +176,8 @@ else
[ "$(ghc --numeric-version)" = "${ghc_ver}" ] [ "$(ghc --numeric-version)" = "${ghc_ver}" ]
ls -lah "$GHCUP_BIN"
if [ "${OS}" = "DARWIN" ] ; then if [ "${OS}" = "DARWIN" ] ; then
eghcup install hls eghcup install hls
$(eghcup whereis hls) --version $(eghcup whereis hls) --version

View File

@@ -1,5 +1,16 @@
# Revision history for ghcup # Revision history for ghcup
## 0.1.17.8 -- XXXX-XX-XX
* Fix HLS build not cleaning up properly on failed installations, fixes [#361](https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/361)
- this also fixes a significant bug on installation failure when combining `--isolate DIR` with `--force`
* Fix parsing of symlinks with multiple slashes, wrt [#353](https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/353)
* Re-enable upgrade functionality for all configurations wrt [#250](https://gitlab.haskell.org/haskell/ghcup-hs/-/merge_requests/250)
## 0.1.17.7 -- 2022-04-21
* Fix `ghcup run` on windows wrt [#345](https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/345)
## 0.1.17.6 -- 2022-03-18 ## 0.1.17.6 -- 2022-03-18
* Vastly improve shell completions wrt [#242](https://gitlab.haskell.org/haskell/ghcup-hs/-/merge_requests/242) * Vastly improve shell completions wrt [#242](https://gitlab.haskell.org/haskell/ghcup-hs/-/merge_requests/242)

View File

@@ -437,6 +437,7 @@ install' _ (_, ListResult {..}) = do
, TarDirDoesNotExist , TarDirDoesNotExist
, FileAlreadyExistsError , FileAlreadyExistsError
, ProcessError , ProcessError
, GHCupShadowed
] ]
run (do run (do
@@ -446,19 +447,19 @@ install' _ (_, ListResult {..}) = do
case lTool of case lTool of
GHC -> do GHC -> do
let vi = getVersionInfo lVer GHC dls let vi = getVersionInfo lVer GHC dls
liftE $ installGHCBin lVer Nothing False $> (vi, dirs, ce) liftE $ installGHCBin lVer GHCupInternal False $> (vi, dirs, ce)
Cabal -> do Cabal -> do
let vi = getVersionInfo lVer Cabal dls let vi = getVersionInfo lVer Cabal dls
liftE $ installCabalBin lVer Nothing False $> (vi, dirs, ce) liftE $ installCabalBin lVer GHCupInternal False $> (vi, dirs, ce)
GHCup -> do GHCup -> do
let vi = snd <$> getLatest dls GHCup let vi = snd <$> getLatest dls GHCup
liftE $ upgradeGHCup Nothing False $> (vi, dirs, ce) liftE $ upgradeGHCup Nothing False False $> (vi, dirs, ce)
HLS -> do HLS -> do
let vi = getVersionInfo lVer HLS dls let vi = getVersionInfo lVer HLS dls
liftE $ installHLSBin lVer Nothing False $> (vi, dirs, ce) liftE $ installHLSBin lVer GHCupInternal False $> (vi, dirs, ce)
Stack -> do Stack -> do
let vi = getVersionInfo lVer Stack dls let vi = getVersionInfo lVer Stack dls
liftE $ installStackBin lVer Nothing False $> (vi, dirs, ce) liftE $ installStackBin lVer GHCupInternal False $> (vi, dirs, ce)
) )
>>= \case >>= \case
VRight (vi, Dirs{..}, Just ce) -> do VRight (vi, Dirs{..}, Just ce) -> do

View File

@@ -96,7 +96,7 @@ data Command
| Config ConfigCommand | Config ConfigCommand
| Whereis WhereisOptions WhereisCommand | Whereis WhereisOptions WhereisCommand
#ifndef DISABLE_UPGRADE #ifndef DISABLE_UPGRADE
| Upgrade UpgradeOpts Bool | Upgrade UpgradeOpts Bool Bool
#endif #endif
| ToolRequirements ToolReqOpts | ToolRequirements ToolReqOpts
| ChangeLog ChangeLogOptions | ChangeLog ChangeLogOptions
@@ -222,18 +222,18 @@ com =
(info (List <$> listOpts <**> helper) (info (List <$> listOpts <**> helper)
(progDesc "Show available GHCs and other tools") (progDesc "Show available GHCs and other tools")
) )
#ifndef DISABLE_UPGRADE
<> command <> command
"upgrade" "upgrade"
(info (info
( (Upgrade <$> upgradeOptsP <*> switch ( (Upgrade <$> upgradeOptsP <*> switch
(short 'f' <> long "force" <> help "Force update") (short 'f' <> long "force" <> help "Force update")
<*> switch
(long "fail-if-shadowed" <> help "Fails after upgrading if the upgraded ghcup binary is shadowed by something else in PATH (useful for CI)")
) )
<**> helper <**> helper
) )
(progDesc "Upgrade ghcup") (progDesc "Upgrade ghcup")
) )
#endif
<> command <> command
"compile" "compile"
( Compile ( Compile

View File

@@ -283,7 +283,7 @@ hlsCompileOpts =
(short 'g' <> long "git-ref" <> metavar "GIT_REFERENCE" <> help (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"
) <*> ) <*>
optional (option str (short 'r' <> long "repository" <> metavar "GIT_REPOSITORY" <> help "The git repository to build from (defaults to GHC upstream)" 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"]) <> completer (gitFileUri ["https://github.com/haskell/haskell-language-server.git"])
)) ))
))) )))
@@ -469,7 +469,7 @@ compile compileCommand settings Dirs{..} runAppState runLogger = do
ghcs ghcs
jobs jobs
ovewrwiteVer ovewrwiteVer
isolateDir (maybe GHCupInternal IsolateDir isolateDir)
cabalProject cabalProject
cabalProjectLocal cabalProjectLocal
patches patches
@@ -524,7 +524,7 @@ compile compileCommand settings Dirs{..} runAppState runLogger = do
addConfArgs addConfArgs
buildFlavour buildFlavour
hadrian hadrian
isolateDir (maybe GHCupInternal IsolateDir isolateDir)
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
let vi = getVersionInfo (_tvVersion targetVer) GHC dls let vi = getVersionInfo (_tvVersion targetVer) GHC dls
when setCompile $ void $ liftE $ when setCompile $ void $ liftE $

View File

@@ -395,7 +395,7 @@ install installCommand settings getAppState' runLogger = case installCommand of
(v, vi) <- liftE $ fromVersion instVer GHC (v, vi) <- liftE $ fromVersion instVer GHC
void $ liftE $ sequenceE (installGHCBin void $ liftE $ sequenceE (installGHCBin
(_tvVersion v) (_tvVersion v)
isolateDir (maybe GHCupInternal IsolateDir isolateDir)
forceInstall forceInstall
) )
$ when instSet $ when (isNothing isolateDir) $ void $ setGHC v SetGHCOnly Nothing $ when instSet $ when (isNothing isolateDir) $ void $ setGHC v SetGHCOnly Nothing
@@ -406,7 +406,7 @@ install installCommand settings getAppState' runLogger = case installCommand of
void $ liftE $ sequenceE (installGHCBindist void $ liftE $ sequenceE (installGHCBindist
(DownloadInfo uri (Just $ RegexDir "ghc-.*") "") (DownloadInfo uri (Just $ RegexDir "ghc-.*") "")
(_tvVersion v) (_tvVersion v)
isolateDir (maybe GHCupInternal IsolateDir isolateDir)
forceInstall forceInstall
) )
$ when instSet $ when (isNothing isolateDir) $ void $ setGHC v SetGHCOnly Nothing $ when instSet $ when (isNothing isolateDir) $ void $ setGHC v SetGHCOnly Nothing
@@ -467,7 +467,7 @@ install installCommand settings getAppState' runLogger = case installCommand of
(_tvVersion -> v, vi) <- liftE $ fromVersion instVer Cabal (_tvVersion -> v, vi) <- liftE $ fromVersion instVer Cabal
void $ liftE $ sequenceE (installCabalBin void $ liftE $ sequenceE (installCabalBin
v v
isolateDir (maybe GHCupInternal IsolateDir isolateDir)
forceInstall forceInstall
) $ when instSet $ when (isNothing isolateDir) $ void $ setCabal v ) $ when instSet $ when (isNothing isolateDir) $ void $ setCabal v
pure vi pure vi
@@ -477,7 +477,7 @@ install installCommand settings getAppState' runLogger = case installCommand of
void $ liftE $ sequenceE (installCabalBindist void $ liftE $ sequenceE (installCabalBindist
(DownloadInfo uri Nothing "") (DownloadInfo uri Nothing "")
v v
isolateDir (maybe GHCupInternal IsolateDir isolateDir)
forceInstall forceInstall
) $ when instSet $ when (isNothing isolateDir) $ void $ setCabal v ) $ when instSet $ when (isNothing isolateDir) $ void $ setCabal v
pure vi pure vi
@@ -518,7 +518,7 @@ install installCommand settings getAppState' runLogger = case installCommand of
(_tvVersion -> v, vi) <- liftE $ fromVersion instVer HLS (_tvVersion -> v, vi) <- liftE $ fromVersion instVer HLS
void $ liftE $ sequenceE (installHLSBin void $ liftE $ sequenceE (installHLSBin
v v
isolateDir (maybe GHCupInternal IsolateDir isolateDir)
forceInstall forceInstall
) $ when instSet $ when (isNothing isolateDir) $ void $ setHLS v SetHLSOnly Nothing ) $ when instSet $ when (isNothing isolateDir) $ void $ setHLS v SetHLSOnly Nothing
pure vi pure vi
@@ -529,7 +529,7 @@ install installCommand settings getAppState' runLogger = case installCommand of
void $ liftE $ sequenceE (installHLSBindist void $ liftE $ sequenceE (installHLSBindist
(DownloadInfo uri (Just $ RegexDir "haskell-language-server-*") "") (DownloadInfo uri (Just $ RegexDir "haskell-language-server-*") "")
v v
isolateDir (maybe GHCupInternal IsolateDir isolateDir)
forceInstall forceInstall
) $ when instSet $ when (isNothing isolateDir) $ void $ setHLS v SetHLSOnly Nothing ) $ when instSet $ when (isNothing isolateDir) $ void $ setHLS v SetHLSOnly Nothing
pure vi pure vi
@@ -578,7 +578,7 @@ install installCommand settings getAppState' runLogger = case installCommand of
(_tvVersion -> v, vi) <- liftE $ fromVersion instVer Stack (_tvVersion -> v, vi) <- liftE $ fromVersion instVer Stack
void $ liftE $ sequenceE (installStackBin void $ liftE $ sequenceE (installStackBin
v v
isolateDir (maybe GHCupInternal IsolateDir isolateDir)
forceInstall forceInstall
) $ when instSet $ when (isNothing isolateDir) $ void $ setStack v ) $ when instSet $ when (isNothing isolateDir) $ void $ setStack v
pure vi pure vi
@@ -588,7 +588,7 @@ install installCommand settings getAppState' runLogger = case installCommand of
void $ liftE $ sequenceE (installStackBindist void $ liftE $ sequenceE (installStackBindist
(DownloadInfo uri Nothing "") (DownloadInfo uri Nothing "")
v v
isolateDir (maybe GHCupInternal IsolateDir isolateDir)
forceInstall forceInstall
) $ when instSet $ when (isNothing isolateDir) $ void $ setStack v ) $ when instSet $ when (isNothing isolateDir) $ void $ setStack v
pure vi pure vi

View File

@@ -61,6 +61,7 @@ data RunOptions = RunOptions
, runHLSVer :: Maybe ToolVersion , runHLSVer :: Maybe ToolVersion
, runStackVer :: Maybe ToolVersion , runStackVer :: Maybe ToolVersion
, runBinDir :: Maybe FilePath , runBinDir :: Maybe FilePath
, runQuick :: Bool
, runCOMMAND :: [String] , runCOMMAND :: [String]
} }
@@ -121,6 +122,8 @@ runOpts =
<> completer (bashCompleter "directory") <> completer (bashCompleter "directory")
) )
) )
<*> switch
(short 'q' <> long "quick" <> help "Avoid any expensive work (such as downloads, version/tag resolution etc.). Disables --install.")
<*> many (argument str (metavar "COMMAND" <> help "The command to run, with arguments (use longopts --). If omitted, just prints the created bin/ dir to stdout and exits.")) <*> many (argument str (metavar "COMMAND" <> help "The command to run, with arguments (use longopts --). If omitted, just prints the created bin/ dir to stdout and exits."))
@@ -219,29 +222,15 @@ run :: forall m.
-> (ReaderT LeanAppState m () -> m ()) -> (ReaderT LeanAppState m () -> m ())
-> m ExitCode -> m ExitCode
run RunOptions{..} runAppState leanAppstate runLogger = do run RunOptions{..} runAppState leanAppstate runLogger = do
r <- if or (fmap (maybe False isToolTag) [runGHCVer, runCabalVer, runHLSVer, runStackVer]) || runInstTool' r <- if not runQuick
then runRUN runAppState $ do then runRUN runAppState $ do
toolchain <- liftE resolveToolchainFull toolchain <- liftE resolveToolchainFull
tmp <- case runBinDir of tmp <- liftIO $ createTmpDir toolchain
Just bindir -> do
liftIO $ createDirRecursive' bindir
liftIO $ canonicalizePath bindir
Nothing -> do
d <- liftIO $ predictableTmpDir toolchain
liftIO $ createDirRecursive' d
liftIO $ canonicalizePath d
liftE $ installToolChainFull toolchain tmp liftE $ installToolChainFull toolchain tmp
pure tmp pure tmp
else runLeanRUN leanAppstate $ do else runLeanRUN leanAppstate $ do
toolchain <- resolveToolchain toolchain <- resolveToolchain
tmp <- case runBinDir of tmp <- liftIO $ createTmpDir toolchain
Just bindir -> do
liftIO $ createDirRecursive' bindir
liftIO $ canonicalizePath bindir
Nothing -> do
d <- liftIO $ predictableTmpDir toolchain
liftIO $ createDirRecursive' d
liftIO $ canonicalizePath d
liftE $ installToolChain toolchain tmp liftE $ installToolChain toolchain tmp
pure tmp pure tmp
case r of case r of
@@ -269,9 +258,16 @@ run RunOptions{..} runAppState leanAppstate runLogger = do
where where
isToolTag :: ToolVersion -> Bool createTmpDir :: Toolchain -> IO FilePath
isToolTag (ToolTag _) = True createTmpDir toolchain =
isToolTag _ = False case runBinDir of
Just bindir -> do
createDirRecursive' bindir
canonicalizePath bindir
Nothing -> do
d <- predictableTmpDir toolchain
createDirRecursive' d
canonicalizePath d
-- TODO: doesn't work for cross -- TODO: doesn't work for cross
resolveToolchainFull :: ( MonadFail m resolveToolchainFull :: ( MonadFail m
@@ -351,25 +347,25 @@ run RunOptions{..} runAppState leanAppstate runLogger = do
Just (GHC, v) -> do Just (GHC, v) -> do
unless isInstalled $ when (runInstTool' && isNothing (_tvTarget v)) $ void $ liftE $ installGHCBin unless isInstalled $ when (runInstTool' && isNothing (_tvTarget v)) $ void $ liftE $ installGHCBin
(_tvVersion v) (_tvVersion v)
Nothing GHCupInternal
False False
setTool GHC v tmp setTool GHC v tmp
Just (Cabal, v) -> do Just (Cabal, v) -> do
unless isInstalled $ when runInstTool' $ void $ liftE $ installCabalBin unless isInstalled $ when runInstTool' $ void $ liftE $ installCabalBin
(_tvVersion v) (_tvVersion v)
Nothing GHCupInternal
False False
setTool Cabal v tmp setTool Cabal v tmp
Just (Stack, v) -> do Just (Stack, v) -> do
unless isInstalled $ when runInstTool' $ void $ liftE $ installStackBin unless isInstalled $ when runInstTool' $ void $ liftE $ installStackBin
(_tvVersion v) (_tvVersion v)
Nothing GHCupInternal
False False
setTool Stack v tmp setTool Stack v tmp
Just (HLS, v) -> do Just (HLS, v) -> do
unless isInstalled $ when runInstTool' $ void $ liftE $ installHLSBin unless isInstalled $ when runInstTool' $ void $ liftE $ installHLSBin
(_tvVersion v) (_tvVersion v)
Nothing GHCupInternal
False False
setTool HLS v tmp setTool HLS v tmp
_ -> pure () _ -> pure ()

View File

@@ -65,9 +65,10 @@ upgradeOptsP =
flag' flag'
UpgradeInplace UpgradeInplace
(short 'i' <> long "inplace" <> help (short 'i' <> long "inplace" <> help
"Upgrade ghcup in-place (wherever it's at)" "Upgrade ghcup in-place"
) )
<|> ( UpgradeAt <|>
( UpgradeAt
<$> option <$> option
str str
(short 't' <> long "target" <> metavar "TARGET_DIR" <> help (short 't' <> long "target" <> metavar "TARGET_DIR" <> help
@@ -92,6 +93,7 @@ type UpgradeEffects = '[ DigestError
, FileDoesNotExistError , FileDoesNotExistError
, CopyError , CopyError
, DownloadFailed , DownloadFailed
, GHCupShadowed
] ]
@@ -120,18 +122,19 @@ upgrade :: ( Monad m
) )
=> UpgradeOpts => UpgradeOpts
-> Bool -> Bool
-> Bool
-> Dirs -> Dirs
-> (forall a. ReaderT AppState m (VEither UpgradeEffects a) -> m (VEither UpgradeEffects a)) -> (forall a. ReaderT AppState m (VEither UpgradeEffects a) -> m (VEither UpgradeEffects a))
-> (ReaderT LeanAppState m () -> m ()) -> (ReaderT LeanAppState m () -> m ())
-> m ExitCode -> m ExitCode
upgrade uOpts force' Dirs{..} runAppState runLogger = do upgrade uOpts force' fatal Dirs{..} runAppState runLogger = do
target <- case uOpts of target <- case uOpts of
UpgradeInplace -> Just <$> liftIO getExecutablePath UpgradeInplace -> Just <$> liftIO getExecutablePath
(UpgradeAt p) -> pure $ Just p (UpgradeAt p) -> pure $ Just p
UpgradeGHCupDir -> pure (Just (binDir </> "ghcup" <> exeExt)) UpgradeGHCupDir -> pure (Just (binDir </> "ghcup" <> exeExt))
runUpgrade runAppState (do runUpgrade runAppState (do
v' <- liftE $ upgradeGHCup target force' v' <- liftE $ upgradeGHCup target force' fatal
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
pure (v', dls) pure (v', dls)
) >>= \case ) >>= \case

View File

@@ -141,9 +141,7 @@ main = do
) )
let listCommands = infoOption let listCommands = infoOption
("install set rm install-cabal list" ("install set rm install-cabal list"
#ifndef DISABLE_UPGRADE
<> " upgrade" <> " upgrade"
#endif
<> " compile debug-info tool-requirements changelog" <> " compile debug-info tool-requirements changelog"
) )
( long "list-commands" ( long "list-commands"
@@ -245,14 +243,10 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
alreadyInstalling' <- alreadyInstalling optCommand newTool alreadyInstalling' <- alreadyInstalling optCommand newTool
when (not alreadyInstalling') $ when (not alreadyInstalling') $
case t of case t of
#ifdef DISABLE_UPGRADE
GHCup -> pure ()
#else
GHCup -> runLogger $ GHCup -> runLogger $
logWarn ("New GHCup version available: " logWarn ("New GHCup version available: "
<> prettyVer l <> prettyVer l
<> ". To upgrade, run 'ghcup upgrade'") <> ". To upgrade, run 'ghcup upgrade'")
#endif
_ -> runLogger $ _ -> runLogger $
logWarn ("New " logWarn ("New "
<> T.pack (prettyShow t) <> T.pack (prettyShow t)
@@ -307,9 +301,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
Config configCommand -> config configCommand settings keybindings runLogger Config configCommand -> config configCommand settings keybindings runLogger
Whereis whereisOptions Whereis whereisOptions
whereisCommand -> whereis whereisCommand whereisOptions runAppState leanAppstate runLogger whereisCommand -> whereis whereisCommand whereisOptions runAppState leanAppstate runLogger
#ifndef DISABLE_UPGRADE Upgrade uOpts force' fatal -> upgrade uOpts force' fatal dirs runAppState runLogger
Upgrade uOpts force' -> upgrade uOpts force' dirs runAppState runLogger
#endif
ToolRequirements topts -> toolRequirements topts runAppState runLogger ToolRequirements topts -> toolRequirements topts runAppState runLogger
ChangeLog changelogOpts -> changelog changelogOpts runAppState runLogger ChangeLog changelogOpts -> changelog changelogOpts runAppState runLogger
Nuke -> nuke appState runLogger Nuke -> nuke appState runLogger
@@ -353,9 +345,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
(HLS, ver) = cmp' HLS (Just $ ToolVersion (mkTVer over)) ver (HLS, ver) = cmp' HLS (Just $ ToolVersion (mkTVer over)) ver
alreadyInstalling (Compile (CompileHLS HLSCompileOptions{ targetHLS = Left tver })) alreadyInstalling (Compile (CompileHLS HLSCompileOptions{ targetHLS = Left tver }))
(HLS, ver) = cmp' HLS (Just $ ToolVersion (mkTVer tver)) ver (HLS, ver) = cmp' HLS (Just $ ToolVersion (mkTVer tver)) ver
#ifndef DISABLE_UPGRADE alreadyInstalling (Upgrade _ _ _) (GHCup, _) = pure True
alreadyInstalling (Upgrade _ _) (GHCup, _) = pure True
#endif
alreadyInstalling _ _ = pure False alreadyInstalling _ _ = pure False
cmp' :: ( HasLog env cmp' :: ( HasLog env

View File

@@ -57,6 +57,13 @@ as e.g. `/etc/bash_completion.d/ghcup` (depending on distro)
and make sure your bashrc sources the startup script and make sure your bashrc sources the startup script
(`/usr/share/bash-completion/bash_completion` on some distros). (`/usr/share/bash-completion/bash_completion` on some distros).
## Portability
`ghcup` is very portable. There are a few exceptions though:
1. `ghcup tui` is only available on non-windows platforms
2. legacy subcommands `ghcup install` (without a tool identifier) and `ghcup install-cabal` may be removed in the future
# Configuration # Configuration
A configuration file can be put in `~/.ghcup/config.yaml`. The default config file A configuration file can be put in `~/.ghcup/config.yaml`. The default config file

View File

@@ -105,7 +105,8 @@ GHCup supports the following tools, which are also known as the **Haskell Toolch
<table> <table>
<thead><tr><th>HLS Version</th><th>Tags</th></tr></thead> <thead><tr><th>HLS Version</th><th>Tags</th></tr></thead>
<tbody> <tbody>
<tr><td>1.6.1.0</td><td><span style="color:blue">latest</span>, <span style="color:green">recommended</span></td></tr> <tr><td>1.7.0.0</td><td><span style="color:blue">latest</span>, <span style="color:green">recommended</span></td></tr>
<tr><td>1.6.1.0</td><td></td></tr>
<tr><td>1.6.0.0</td><td></td></tr> <tr><td>1.6.0.0</td><td></td></tr>
<tr><td>1.5.1</td><td></td></tr> <tr><td>1.5.1</td><td></td></tr>
<tr><td>1.5.0</td><td></td></tr> <tr><td>1.5.0</td><td></td></tr>

View File

@@ -16,6 +16,8 @@ The Glorious Glasgow Haskell Compilation System, version 8.10.7
If this fails, consult [the Getting started page](../install) for information on If this fails, consult [the Getting started page](../install) for information on
how to install Haskell on your computer. how to install Haskell on your computer.
This guide is partly based on [Gil Mizrahi's blog](https://gilmi.me/blog/post/2021/08/14/hs-core-tools).
## Compiling programs with ghc ## Compiling programs with ghc
Running `ghc` invokes the Glasgow Haskell Compiler (GHC), and can be used to Running `ghc` invokes the Glasgow Haskell Compiler (GHC), and can be used to
@@ -326,6 +328,7 @@ see the [Cabal user guide](https://cabal.readthedocs.io/en/stable/getting-starte
<a href="https://hackage.haskell.org/" class="btn btn-primary" role="button">Discover Haskell packages</a> <a href="https://hackage.haskell.org/" class="btn btn-primary" role="button">Discover Haskell packages</a>
<a href="https://hackage.haskell.org/package/base" class="btn btn-primary" role="button">The standard library</a> <a href="https://hackage.haskell.org/package/base" class="btn btn-primary" role="button">The standard library</a>
<a href="https://haskell-language-server.readthedocs.io/en/stable/installation.html" class="btn btn-primary" role="button">Editor setup with HLS</a> <a href="https://haskell-language-server.readthedocs.io/en/stable/installation.html" class="btn btn-primary" role="button">Editor setup with HLS</a>
<a href="https://play-haskell.tomsmeding.com/play" class="btn btn-primary" role="button">Online playground</a>
</div> </div>
## How to learn Haskell proper ## How to learn Haskell proper

View File

@@ -1,6 +1,6 @@
cabal-version: 3.0 cabal-version: 3.0
name: ghcup name: ghcup
version: 0.1.17.6 version: 0.1.17.8
license: LGPL-3.0-only license: LGPL-3.0-only
license-file: LICENSE license-file: LICENSE
copyright: Julian Ospald 2020 copyright: Julian Ospald 2020
@@ -48,13 +48,6 @@ flag no-exe
default: False default: False
manual: True manual: True
flag disable-upgrade
description:
Disable upgrade functionality. This is mainly to support brew packagers.
default: False
manual: True
library library
exposed-modules: exposed-modules:
GHCup GHCup
@@ -204,6 +197,7 @@ executable ghcup
GHCup.OptParse.Set GHCup.OptParse.Set
GHCup.OptParse.ToolRequirements GHCup.OptParse.ToolRequirements
GHCup.OptParse.UnSet GHCup.OptParse.UnSet
GHCup.OptParse.Upgrade
GHCup.OptParse.Whereis GHCup.OptParse.Whereis
hs-source-dirs: app/ghcup hs-source-dirs: app/ghcup
@@ -277,11 +271,6 @@ executable ghcup
if flag(no-exe) if flag(no-exe)
buildable: False buildable: False
if flag(disable-upgrade)
cpp-options: -DDISABLE_UPGRADE
else
other-modules: GHCup.OptParse.Upgrade
test-suite ghcup-test test-suite ghcup-test
type: exitcode-stdio-1.0 type: exitcode-stdio-1.0

View File

@@ -187,7 +187,7 @@ installGHCBindist :: ( MonadFail m
) )
=> DownloadInfo -- ^ where/how to download => DownloadInfo -- ^ where/how to download
-> Version -- ^ the version to install -> Version -- ^ the version to install
-> Maybe FilePath -- ^ isolated filepath if user passed any -> InstallDir
-> Bool -- ^ Force install -> Bool -- ^ Force install
-> Excepts -> Excepts
'[ AlreadyInstalled '[ AlreadyInstalled
@@ -205,7 +205,7 @@ installGHCBindist :: ( MonadFail m
] ]
m m
() ()
installGHCBindist dlinfo ver isoFilepath forceInstall = do installGHCBindist dlinfo ver installDir forceInstall = do
let tver = mkTVer ver let tver = mkTVer ver
lift $ logDebug $ "Requested to install GHC with " <> prettyVer ver lift $ logDebug $ "Requested to install GHC with " <> prettyVer ver
@@ -215,12 +215,12 @@ installGHCBindist dlinfo ver isoFilepath forceInstall = do
if if
| not forceInstall | not forceInstall
, regularGHCInstalled , regularGHCInstalled
, Nothing <- isoFilepath -> do , GHCupInternal <- installDir -> do
throwE $ AlreadyInstalled GHC ver throwE $ AlreadyInstalled GHC ver
| forceInstall | forceInstall
, regularGHCInstalled , regularGHCInstalled
, Nothing <- isoFilepath -> do , GHCupInternal <- installDir -> do
lift $ logInfo "Removing the currently installed GHC version first!" lift $ logInfo "Removing the currently installed GHC version first!"
liftE $ rmGHCVer tver liftE $ rmGHCVer tver
@@ -229,17 +229,18 @@ installGHCBindist dlinfo ver isoFilepath forceInstall = do
-- download (or use cached version) -- download (or use cached version)
dl <- liftE $ downloadCached dlinfo Nothing dl <- liftE $ downloadCached dlinfo Nothing
-- prepare paths
ghcdir <- lift $ ghcupGHCDir tver
toolchainSanityChecks toolchainSanityChecks
case isoFilepath of case installDir of
Just isoDir -> do -- isolated install IsolateDir isoDir -> do -- isolated install
lift $ logInfo $ "isolated installing GHC to " <> T.pack isoDir lift $ logInfo $ "isolated installing GHC to " <> T.pack isoDir
liftE $ installPackedGHC dl (view dlSubdir dlinfo) isoDir ver forceInstall liftE $ installPackedGHC dl (view dlSubdir dlinfo) (IsolateDirResolved isoDir) ver forceInstall
Nothing -> do -- regular install GHCupInternal -> do -- regular install
liftE $ installPackedGHC dl (view dlSubdir dlinfo) ghcdir ver forceInstall -- prepare paths
ghcdir <- lift $ ghcupGHCDir tver
liftE $ installPackedGHC dl (view dlSubdir dlinfo) (GHCupDir ghcdir) ver forceInstall
-- make symlinks & stuff when regular install, -- make symlinks & stuff when regular install,
liftE $ postGHCInstall tver liftE $ postGHCInstall tver
@@ -271,7 +272,7 @@ installPackedGHC :: ( MonadMask m
) )
=> FilePath -- ^ Path to the packed GHC bindist => FilePath -- ^ Path to the packed GHC bindist
-> Maybe TarDir -- ^ Subdir of the archive -> Maybe TarDir -- ^ Subdir of the archive
-> FilePath -- ^ Path to install to -> InstallDirResolved
-> Version -- ^ The GHC version -> Version -- ^ The GHC version
-> Bool -- ^ Force install -> Bool -- ^ Force install
-> Excepts -> Excepts
@@ -299,7 +300,11 @@ installPackedGHC dl msubdir inst ver forceInstall = do
msubdir msubdir
liftE $ runBuildAction tmpUnpack liftE $ runBuildAction tmpUnpack
(Just inst) (case inst of
IsolateDirResolved _ -> Nothing -- don't clean up for isolated installs, since that'd potentially delete other
-- user files if '--force' is supplied
GHCupDir d -> Just d
)
(installUnpackedGHC workdir inst ver) (installUnpackedGHC workdir inst ver)
@@ -316,10 +321,10 @@ installUnpackedGHC :: ( MonadReader env m
, MonadMask m , MonadMask m
) )
=> FilePath -- ^ Path to the unpacked GHC bindist (where the configure script resides) => FilePath -- ^ Path to the unpacked GHC bindist (where the configure script resides)
-> FilePath -- ^ Path to install to -> InstallDirResolved -- ^ Path to install to
-> Version -- ^ The GHC version -> Version -- ^ The GHC version
-> Excepts '[ProcessError] m () -> Excepts '[ProcessError] m ()
installUnpackedGHC path inst ver installUnpackedGHC path (fromInstallDir -> inst) ver
| isWindows = do | isWindows = do
lift $ logInfo "Installing GHC (this may take a while)" lift $ logInfo "Installing GHC (this may take a while)"
-- Windows bindists are relocatable and don't need -- Windows bindists are relocatable and don't need
@@ -369,7 +374,7 @@ installGHCBin :: ( MonadFail m
, MonadUnliftIO m , MonadUnliftIO m
) )
=> Version -- ^ the version to install => Version -- ^ the version to install
-> Maybe FilePath -- ^ isolated install filepath, if user passed any -> InstallDir
-> Bool -- ^ force install -> Bool -- ^ force install
-> Excepts -> Excepts
'[ AlreadyInstalled '[ AlreadyInstalled
@@ -387,9 +392,9 @@ installGHCBin :: ( MonadFail m
] ]
m m
() ()
installGHCBin ver isoFilepath forceInstall = do installGHCBin ver installDir forceInstall = do
dlinfo <- liftE $ getDownloadInfo GHC ver dlinfo <- liftE $ getDownloadInfo GHC ver
liftE $ installGHCBindist dlinfo ver isoFilepath forceInstall liftE $ installGHCBindist dlinfo ver installDir forceInstall
-- | Like 'installCabalBin', except takes the 'DownloadInfo' as -- | Like 'installCabalBin', except takes the 'DownloadInfo' as
@@ -408,7 +413,7 @@ installCabalBindist :: ( MonadMask m
) )
=> DownloadInfo => DownloadInfo
-> Version -> Version
-> Maybe FilePath -- ^ isolated install filepath, if user provides any. -> InstallDir
-> Bool -- ^ Force install -> Bool -- ^ Force install
-> Excepts -> Excepts
'[ AlreadyInstalled '[ AlreadyInstalled
@@ -425,7 +430,7 @@ installCabalBindist :: ( MonadMask m
] ]
m m
() ()
installCabalBindist dlinfo ver isoFilepath forceInstall = do installCabalBindist dlinfo ver installDir forceInstall = do
lift $ logDebug $ "Requested to install cabal version " <> prettyVer ver lift $ logDebug $ "Requested to install cabal version " <> prettyVer ver
PlatformRequest {..} <- lift getPlatformReq PlatformRequest {..} <- lift getPlatformReq
@@ -437,12 +442,12 @@ installCabalBindist dlinfo ver isoFilepath forceInstall = do
if if
| not forceInstall | not forceInstall
, regularCabalInstalled , regularCabalInstalled
, Nothing <- isoFilepath -> do , GHCupInternal <- installDir -> do
throwE $ AlreadyInstalled Cabal ver throwE $ AlreadyInstalled Cabal ver
| forceInstall | forceInstall
, regularCabalInstalled , regularCabalInstalled
, Nothing <- isoFilepath -> do , GHCupInternal <- installDir -> do
lift $ logInfo "Removing the currently installed version first!" lift $ logInfo "Removing the currently installed version first!"
liftE $ rmCabalVer ver liftE $ rmCabalVer ver
@@ -460,30 +465,33 @@ installCabalBindist dlinfo ver isoFilepath forceInstall = do
-- the subdir of the archive where we do the work -- the subdir of the archive where we do the work
workdir <- maybe (pure tmpUnpack) (liftE . intoSubdir tmpUnpack) (view dlSubdir dlinfo) workdir <- maybe (pure tmpUnpack) (liftE . intoSubdir tmpUnpack) (view dlSubdir dlinfo)
case isoFilepath of case installDir of
Just isoDir -> do -- isolated install IsolateDir isoDir -> do -- isolated install
lift $ logInfo $ "isolated installing Cabal to " <> T.pack isoDir lift $ logInfo $ "isolated installing Cabal to " <> T.pack isoDir
liftE $ installCabalUnpacked workdir isoDir Nothing forceInstall liftE $ installCabalUnpacked workdir (IsolateDirResolved isoDir) ver forceInstall
Nothing -> do -- regular install GHCupInternal -> do -- regular install
liftE $ installCabalUnpacked workdir binDir (Just ver) forceInstall liftE $ installCabalUnpacked workdir (GHCupDir binDir) ver forceInstall
-- | Install an unpacked cabal distribution.Symbol -- | Install an unpacked cabal distribution.Symbol
installCabalUnpacked :: (MonadCatch m, HasLog env, MonadIO m, MonadReader env m) installCabalUnpacked :: (MonadCatch m, HasLog env, MonadIO m, MonadReader env m)
=> FilePath -- ^ Path to the unpacked cabal bindist (where the executable resides) => FilePath -- ^ Path to the unpacked cabal bindist (where the executable resides)
-> FilePath -- ^ Path to install to -> InstallDirResolved -- ^ Path to install to
-> Maybe Version -- ^ Nothing for isolated install -> Version
-> Bool -- ^ Force Install -> Bool -- ^ Force Install
-> Excepts '[CopyError, FileAlreadyExistsError] m () -> Excepts '[CopyError, FileAlreadyExistsError] m ()
installCabalUnpacked path inst mver' forceInstall = do installCabalUnpacked path inst ver forceInstall = do
lift $ logInfo "Installing cabal" lift $ logInfo "Installing cabal"
let cabalFile = "cabal" let cabalFile = "cabal"
liftIO $ createDirRecursive' inst liftIO $ createDirRecursive' (fromInstallDir inst)
let destFileName = cabalFile let destFileName = cabalFile
<> maybe "" (("-" <>) . T.unpack . prettyVer) mver' <> (case inst of
IsolateDirResolved _ -> ""
GHCupDir _ -> ("-" <>) . T.unpack . prettyVer $ ver
)
<> exeExt <> exeExt
let destPath = inst </> destFileName let destPath = fromInstallDir inst </> destFileName
unless forceInstall -- Overwrite it when it IS a force install unless forceInstall -- Overwrite it when it IS a force install
(liftE $ throwIfFileAlreadyExists destPath) (liftE $ throwIfFileAlreadyExists destPath)
@@ -510,7 +518,7 @@ installCabalBin :: ( MonadMask m
, MonadFail m , MonadFail m
) )
=> Version => Version
-> Maybe FilePath -- isolated install Path, if user provided any -> InstallDir
-> Bool -- force install -> Bool -- force install
-> Excepts -> Excepts
'[ AlreadyInstalled '[ AlreadyInstalled
@@ -527,9 +535,9 @@ installCabalBin :: ( MonadMask m
] ]
m m
() ()
installCabalBin ver isoFilepath forceInstall = do installCabalBin ver installDir forceInstall = do
dlinfo <- liftE $ getDownloadInfo Cabal ver dlinfo <- liftE $ getDownloadInfo Cabal ver
installCabalBindist dlinfo ver isoFilepath forceInstall installCabalBindist dlinfo ver installDir forceInstall
-- | Like 'installHLSBin, except takes the 'DownloadInfo' as -- | Like 'installHLSBin, except takes the 'DownloadInfo' as
@@ -548,7 +556,7 @@ installHLSBindist :: ( MonadMask m
) )
=> DownloadInfo => DownloadInfo
-> Version -> Version
-> Maybe FilePath -- ^ isolated install path, if user passed any -> InstallDir -- ^ isolated install path, if user passed any
-> Bool -- ^ Force install -> Bool -- ^ Force install
-> Excepts -> Excepts
'[ AlreadyInstalled '[ AlreadyInstalled
@@ -567,7 +575,7 @@ installHLSBindist :: ( MonadMask m
] ]
m m
() ()
installHLSBindist dlinfo ver isoFilepath forceInstall = do installHLSBindist dlinfo ver installDir forceInstall = do
lift $ logDebug $ "Requested to install hls version " <> prettyVer ver lift $ logDebug $ "Requested to install hls version " <> prettyVer ver
PlatformRequest {..} <- lift getPlatformReq PlatformRequest {..} <- lift getPlatformReq
@@ -578,12 +586,12 @@ installHLSBindist dlinfo ver isoFilepath forceInstall = do
if if
| not forceInstall | not forceInstall
, regularHLSInstalled , regularHLSInstalled
, Nothing <- isoFilepath -> do -- regular install , GHCupInternal <- installDir -> do -- regular install
throwE $ AlreadyInstalled HLS ver throwE $ AlreadyInstalled HLS ver
| forceInstall | forceInstall
, regularHLSInstalled , regularHLSInstalled
, Nothing <- isoFilepath -> do -- regular forced install , GHCupInternal <- installDir -> do -- regular forced install
lift $ logInfo "Removing the currently installed version of HLS before force installing!" lift $ logInfo "Removing the currently installed version of HLS before force installing!"
liftE $ rmHLSVer ver liftE $ rmHLSVer ver
@@ -604,22 +612,23 @@ installHLSBindist dlinfo ver isoFilepath forceInstall = do
if if
| not forceInstall | not forceInstall
, not legacy , not legacy
, (Just fp) <- isoFilepath -> liftE $ installDestSanityCheck fp , (IsolateDir fp) <- installDir -> liftE $ installDestSanityCheck (IsolateDirResolved fp)
| otherwise -> pure () | otherwise -> pure ()
case isoFilepath of case installDir of
Just isoDir -> do IsolateDir isoDir -> do
lift $ logInfo $ "isolated installing HLS to " <> T.pack isoDir lift $ logInfo $ "isolated installing HLS to " <> T.pack isoDir
if legacy if legacy
then liftE $ installHLSUnpackedLegacy workdir isoDir Nothing forceInstall then liftE $ installHLSUnpackedLegacy workdir (IsolateDirResolved isoDir) ver forceInstall
else liftE $ runBuildAction tmpUnpack Nothing $ installHLSUnpacked workdir isoDir ver else liftE $ runBuildAction tmpUnpack Nothing $ installHLSUnpacked workdir (IsolateDirResolved isoDir) ver
Nothing -> do GHCupInternal -> do
if legacy if legacy
then liftE $ installHLSUnpackedLegacy workdir binDir (Just ver) forceInstall then liftE $ installHLSUnpackedLegacy workdir (GHCupDir binDir) ver forceInstall
else do else do
inst <- ghcupHLSDir ver inst <- ghcupHLSDir ver
liftE $ runBuildAction tmpUnpack Nothing $ installHLSUnpacked workdir inst ver liftE $ runBuildAction tmpUnpack (Just inst)
$ installHLSUnpacked workdir (GHCupDir inst) ver
liftE $ setHLS ver SetHLS_XYZ Nothing liftE $ setHLS ver SetHLS_XYZ Nothing
@@ -631,10 +640,10 @@ isLegacyHLSBindist path = do
-- | Install an unpacked hls distribution. -- | Install an unpacked hls distribution.
installHLSUnpacked :: (MonadMask m, MonadUnliftIO m, MonadReader env m, MonadFail m, HasLog env, HasDirs env, HasSettings env, MonadCatch m, MonadIO m) installHLSUnpacked :: (MonadMask m, MonadUnliftIO m, MonadReader env m, MonadFail m, HasLog env, HasDirs env, HasSettings env, MonadCatch m, MonadIO m)
=> FilePath -- ^ Path to the unpacked hls bindist (where the executable resides) => FilePath -- ^ Path to the unpacked hls bindist (where the executable resides)
-> FilePath -- ^ Path to install to -> InstallDirResolved -- ^ Path to install to
-> Version -> Version
-> Excepts '[ProcessError, CopyError, FileAlreadyExistsError, NotInstalled] m () -> Excepts '[ProcessError, CopyError, FileAlreadyExistsError, NotInstalled] m ()
installHLSUnpacked path inst _ = do installHLSUnpacked path (fromInstallDir -> inst) _ = do
lift $ logInfo "Installing HLS" lift $ logInfo "Installing HLS"
liftIO $ createDirRecursive' inst liftIO $ createDirRecursive' inst
lEM $ make ["PREFIX=" <> inst, "install"] (Just path) lEM $ make ["PREFIX=" <> inst, "install"] (Just path)
@@ -642,13 +651,13 @@ installHLSUnpacked path inst _ = do
-- | Install an unpacked hls distribution (legacy). -- | Install an unpacked hls distribution (legacy).
installHLSUnpackedLegacy :: (MonadReader env m, MonadFail m, HasLog env, MonadCatch m, MonadIO m) installHLSUnpackedLegacy :: (MonadReader env m, MonadFail m, HasLog env, MonadCatch m, MonadIO m)
=> FilePath -- ^ Path to the unpacked hls bindist (where the executable resides) => FilePath -- ^ Path to the unpacked hls bindist (where the executable resides)
-> FilePath -- ^ Path to install to -> InstallDirResolved -- ^ Path to install to
-> Maybe Version -- ^ Nothing for isolated install -> Version
-> Bool -- ^ is it a force install -> Bool -- ^ is it a force install
-> Excepts '[CopyError, FileAlreadyExistsError] m () -> Excepts '[CopyError, FileAlreadyExistsError] m ()
installHLSUnpackedLegacy path inst mver' forceInstall = do installHLSUnpackedLegacy path installDir ver forceInstall = do
lift $ logInfo "Installing HLS" lift $ logInfo "Installing HLS"
liftIO $ createDirRecursive' inst liftIO $ createDirRecursive' (fromInstallDir installDir)
-- install haskell-language-server-<ghcver> -- install haskell-language-server-<ghcver>
bins@(_:_) <- liftIO $ findFiles bins@(_:_) <- liftIO $ findFiles
@@ -659,11 +668,14 @@ installHLSUnpackedLegacy path inst mver' forceInstall = do
) )
forM_ bins $ \f -> do forM_ bins $ \f -> do
let toF = dropSuffix exeExt f let toF = dropSuffix exeExt f
<> maybe "" (("~" <>) . T.unpack . prettyVer) mver' <> (case installDir of
IsolateDirResolved _ -> ""
GHCupDir _ -> ("~" <>) . T.unpack . prettyVer $ ver
)
<> exeExt <> exeExt
let srcPath = path </> f let srcPath = path </> f
let destPath = inst </> toF let destPath = fromInstallDir installDir </> toF
unless forceInstall -- if it is a force install, overwrite it. unless forceInstall -- if it is a force install, overwrite it.
(liftE $ throwIfFileAlreadyExists destPath) (liftE $ throwIfFileAlreadyExists destPath)
@@ -676,10 +688,13 @@ installHLSUnpackedLegacy path inst mver' forceInstall = do
-- install haskell-language-server-wrapper -- install haskell-language-server-wrapper
let wrapper = "haskell-language-server-wrapper" let wrapper = "haskell-language-server-wrapper"
toF = wrapper toF = wrapper
<> maybe "" (("-" <>) . T.unpack . prettyVer) mver' <> (case installDir of
IsolateDirResolved _ -> ""
GHCupDir _ -> ("-" <>) . T.unpack . prettyVer $ ver
)
<> exeExt <> exeExt
srcWrapperPath = path </> wrapper <> exeExt srcWrapperPath = path </> wrapper <> exeExt
destWrapperPath = inst </> toF destWrapperPath = fromInstallDir installDir </> toF
unless forceInstall unless forceInstall
(liftE $ throwIfFileAlreadyExists destWrapperPath) (liftE $ throwIfFileAlreadyExists destWrapperPath)
@@ -708,7 +723,7 @@ installHLSBin :: ( MonadMask m
, MonadFail m , MonadFail m
) )
=> Version => Version
-> Maybe FilePath -- isolated install Dir (if any) -> InstallDir
-> Bool -- force install -> Bool -- force install
-> Excepts -> Excepts
'[ AlreadyInstalled '[ AlreadyInstalled
@@ -727,9 +742,9 @@ installHLSBin :: ( MonadMask m
] ]
m m
() ()
installHLSBin ver isoFilepath forceInstall = do installHLSBin ver installDir forceInstall = do
dlinfo <- liftE $ getDownloadInfo HLS ver dlinfo <- liftE $ getDownloadInfo HLS ver
installHLSBindist dlinfo ver isoFilepath forceInstall installHLSBindist dlinfo ver installDir forceInstall
compileHLS :: ( MonadMask m compileHLS :: ( MonadMask m
@@ -749,7 +764,7 @@ compileHLS :: ( MonadMask m
-> [Version] -> [Version]
-> Maybe Int -> Maybe Int
-> Maybe Version -> Maybe Version
-> Maybe FilePath -> InstallDir
-> Maybe (Either FilePath URI) -> Maybe (Either FilePath URI)
-> Maybe URI -> Maybe URI
-> Maybe (Either FilePath [URI]) -- ^ patches -> Maybe (Either FilePath [URI]) -- ^ patches
@@ -764,7 +779,7 @@ compileHLS :: ( MonadMask m
, BuildFailed , BuildFailed
, NotInstalled , NotInstalled
] m Version ] m Version
compileHLS targetHLS ghcs jobs ov isolateDir cabalProject cabalProjectLocal patches cabalArgs = do compileHLS targetHLS ghcs jobs ov installDir cabalProject cabalProjectLocal patches cabalArgs = do
PlatformRequest { .. } <- lift getPlatformReq PlatformRequest { .. } <- lift getPlatformReq
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
Dirs { .. } <- lift getDirs Dirs { .. } <- lift getDirs
@@ -837,8 +852,8 @@ compileHLS targetHLS ghcs jobs ov isolateDir cabalProject cabalProjectLocal patc
workdir workdir
Nothing Nothing
(reThrowAll @_ @'[GPGError, DownloadFailed, DigestError, PatchFailed, ProcessError, FileAlreadyExistsError, CopyError] @'[BuildFailed] (BuildFailed workdir) $ do (reThrowAll @_ @'[GPGError, DownloadFailed, DigestError, PatchFailed, ProcessError, FileAlreadyExistsError, CopyError] @'[BuildFailed] (BuildFailed workdir) $ do
let installDir = workdir </> "out" let tmpInstallDir = workdir </> "out"
liftIO $ createDirRecursive' installDir liftIO $ createDirRecursive' tmpInstallDir
-- apply patches -- apply patches
liftE $ applyAnyPatch patches workdir liftE $ applyAnyPatch patches workdir
@@ -861,8 +876,8 @@ compileHLS targetHLS ghcs jobs ov isolateDir cabalProject cabalProjectLocal patc
cpl <- liftE $ download uri Nothing Nothing tmpUnpack (Just (cp <.> "local")) False cpl <- liftE $ download uri Nothing Nothing tmpUnpack (Just (cp <.> "local")) False
copyFileE cpl (workdir </> cp <.> "local") copyFileE cpl (workdir </> cp <.> "local")
artifacts <- forM (sort ghcs) $ \ghc -> do artifacts <- forM (sort ghcs) $ \ghc -> do
let ghcInstallDir = installDir </> T.unpack (prettyVer ghc) let ghcInstallDir = tmpInstallDir </> T.unpack (prettyVer ghc)
liftIO $ createDirRecursive' installDir liftIO $ createDirRecursive' tmpInstallDir
lift $ logInfo $ "Building HLS " <> prettyVer installVer <> " for GHC version " <> prettyVer ghc lift $ logInfo $ "Building HLS " <> prettyVer installVer <> " for GHC version " <> prettyVer ghc
liftE $ lEM @_ @'[ProcessError] $ liftE $ lEM @_ @'[ProcessError] $
execLogged "cabal" ( [ "v2-install" execLogged "cabal" ( [ "v2-install"
@@ -885,17 +900,17 @@ compileHLS targetHLS ghcs jobs ov isolateDir cabalProject cabalProjectLocal patc
forM_ artifacts $ \artifact -> do forM_ artifacts $ \artifact -> do
liftIO $ renameFile (artifact </> "haskell-language-server" <.> exeExt) liftIO $ renameFile (artifact </> "haskell-language-server" <.> exeExt)
(installDir </> "haskell-language-server-" <> takeFileName artifact <.> exeExt) (tmpInstallDir </> "haskell-language-server-" <> takeFileName artifact <.> exeExt)
liftIO $ renameFile (artifact </> "haskell-language-server-wrapper" <.> exeExt) liftIO $ renameFile (artifact </> "haskell-language-server-wrapper" <.> exeExt)
(installDir </> "haskell-language-server-wrapper" <.> exeExt) (tmpInstallDir </> "haskell-language-server-wrapper" <.> exeExt)
liftIO $ rmPathForcibly artifact liftIO $ rmPathForcibly artifact
case isolateDir of case installDir of
Just isoDir -> do IsolateDir isoDir -> do
lift $ logInfo $ "isolated installing HLS to " <> T.pack isoDir lift $ logInfo $ "isolated installing HLS to " <> T.pack isoDir
liftE $ installHLSUnpackedLegacy installDir isoDir Nothing True liftE $ installHLSUnpackedLegacy tmpInstallDir (IsolateDirResolved isoDir) installVer True
Nothing -> do GHCupInternal -> do
liftE $ installHLSUnpackedLegacy installDir binDir (Just installVer) True liftE $ installHLSUnpackedLegacy tmpInstallDir (GHCupDir binDir) installVer True
) )
pure installVer pure installVer
@@ -919,7 +934,7 @@ installStackBin :: ( MonadMask m
, MonadFail m , MonadFail m
) )
=> Version => Version
-> Maybe FilePath -- ^ isolate install Dir (if any) -> InstallDir
-> Bool -- ^ Force install -> Bool -- ^ Force install
-> Excepts -> Excepts
'[ AlreadyInstalled '[ AlreadyInstalled
@@ -936,9 +951,9 @@ installStackBin :: ( MonadMask m
] ]
m m
() ()
installStackBin ver isoFilepath forceInstall = do installStackBin ver installDir forceInstall = do
dlinfo <- liftE $ getDownloadInfo Stack ver dlinfo <- liftE $ getDownloadInfo Stack ver
installStackBindist dlinfo ver isoFilepath forceInstall installStackBindist dlinfo ver installDir forceInstall
-- | Like 'installStackBin', except takes the 'DownloadInfo' as -- | Like 'installStackBin', except takes the 'DownloadInfo' as
@@ -957,7 +972,7 @@ installStackBindist :: ( MonadMask m
) )
=> DownloadInfo => DownloadInfo
-> Version -> Version
-> Maybe FilePath -- ^ isolate install Dir (if any) -> InstallDir
-> Bool -- ^ Force install -> Bool -- ^ Force install
-> Excepts -> Excepts
'[ AlreadyInstalled '[ AlreadyInstalled
@@ -974,7 +989,7 @@ installStackBindist :: ( MonadMask m
] ]
m m
() ()
installStackBindist dlinfo ver isoFilepath forceInstall = do installStackBindist dlinfo ver installDir forceInstall = do
lift $ logDebug $ "Requested to install stack version " <> prettyVer ver lift $ logDebug $ "Requested to install stack version " <> prettyVer ver
PlatformRequest {..} <- lift getPlatformReq PlatformRequest {..} <- lift getPlatformReq
@@ -985,12 +1000,12 @@ installStackBindist dlinfo ver isoFilepath forceInstall = do
if if
| not forceInstall | not forceInstall
, regularStackInstalled , regularStackInstalled
, Nothing <- isoFilepath -> do , GHCupInternal <- installDir -> do
throwE $ AlreadyInstalled Stack ver throwE $ AlreadyInstalled Stack ver
| forceInstall | forceInstall
, regularStackInstalled , regularStackInstalled
, Nothing <- isoFilepath -> do , GHCupInternal <- installDir -> do
lift $ logInfo "Removing the currently installed version of Stack first!" lift $ logInfo "Removing the currently installed version of Stack first!"
liftE $ rmStackVer ver liftE $ rmStackVer ver
@@ -1007,29 +1022,32 @@ installStackBindist dlinfo ver isoFilepath forceInstall = do
-- the subdir of the archive where we do the work -- the subdir of the archive where we do the work
workdir <- maybe (pure tmpUnpack) (liftE . intoSubdir tmpUnpack) (view dlSubdir dlinfo) workdir <- maybe (pure tmpUnpack) (liftE . intoSubdir tmpUnpack) (view dlSubdir dlinfo)
case isoFilepath of case installDir of
Just isoDir -> do -- isolated install IsolateDir isoDir -> do -- isolated install
lift $ logInfo $ "isolated installing Stack to " <> T.pack isoDir lift $ logInfo $ "isolated installing Stack to " <> T.pack isoDir
liftE $ installStackUnpacked workdir isoDir Nothing forceInstall liftE $ installStackUnpacked workdir (IsolateDirResolved isoDir) ver forceInstall
Nothing -> do -- regular install GHCupInternal -> do -- regular install
liftE $ installStackUnpacked workdir binDir (Just ver) forceInstall liftE $ installStackUnpacked workdir (GHCupDir binDir) ver forceInstall
-- | Install an unpacked stack distribution. -- | Install an unpacked stack distribution.
installStackUnpacked :: (MonadReader env m, HasLog env, MonadCatch m, MonadIO m) installStackUnpacked :: (MonadReader env m, HasLog env, MonadCatch m, MonadIO m)
=> FilePath -- ^ Path to the unpacked stack bindist (where the executable resides) => FilePath -- ^ Path to the unpacked stack bindist (where the executable resides)
-> FilePath -- ^ Path to install to -> InstallDirResolved
-> Maybe Version -- ^ Nothing for isolated installs -> Version
-> Bool -- ^ Force install -> Bool -- ^ Force install
-> Excepts '[CopyError, FileAlreadyExistsError] m () -> Excepts '[CopyError, FileAlreadyExistsError] m ()
installStackUnpacked path inst mver' forceInstall = do installStackUnpacked path installDir ver forceInstall = do
lift $ logInfo "Installing stack" lift $ logInfo "Installing stack"
let stackFile = "stack" let stackFile = "stack"
liftIO $ createDirRecursive' inst liftIO $ createDirRecursive' (fromInstallDir installDir)
let destFileName = stackFile let destFileName = stackFile
<> maybe "" (("-" <>) . T.unpack . prettyVer) mver' <> (case installDir of
IsolateDirResolved _ -> ""
GHCupDir _ -> ("-" <>) . T.unpack . prettyVer $ ver
)
<> exeExt <> exeExt
destPath = inst </> destFileName destPath = fromInstallDir installDir </> destFileName
unless forceInstall unless forceInstall
(liftE $ throwIfFileAlreadyExists destPath) (liftE $ throwIfFileAlreadyExists destPath)
@@ -1223,7 +1241,7 @@ setHLS :: ( MonadReader env m
, MonadUnliftIO m , MonadUnliftIO m
) )
=> Version => Version
-> SetHLS -- Nothing for legacy -> SetHLS
-> Maybe FilePath -- if set, signals that we're not operating in ~/.ghcup/bin -> Maybe FilePath -- if set, signals that we're not operating in ~/.ghcup/bin
-- and don't want mess with other versions -- and don't want mess with other versions
-> Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ()
@@ -2121,7 +2139,7 @@ compileGHC :: ( MonadMask m
-> [Text] -- ^ additional args to ./configure -> [Text] -- ^ additional args to ./configure
-> Maybe String -- ^ build flavour -> Maybe String -- ^ build flavour
-> Bool -> Bool
-> Maybe FilePath -- ^ isolate dir -> InstallDir
-> Excepts -> Excepts
'[ AlreadyInstalled '[ AlreadyInstalled
, BuildFailed , BuildFailed
@@ -2146,7 +2164,7 @@ compileGHC :: ( MonadMask m
] ]
m m
GHCTargetVersion GHCTargetVersion
compileGHC targetGhc ov bstrap jobs mbuildConfig patches aargs buildFlavour hadrian isolateDir compileGHC targetGhc ov bstrap jobs mbuildConfig patches aargs buildFlavour hadrian installDir
= do = do
PlatformRequest { .. } <- lift getPlatformReq PlatformRequest { .. } <- lift getPlatformReq
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
@@ -2219,18 +2237,18 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patches aargs buildFlavour hadr
alreadySet <- fmap (== Just installVer) $ lift $ ghcSet (_tvTarget installVer) alreadySet <- fmap (== Just installVer) $ lift $ ghcSet (_tvTarget installVer)
when alreadyInstalled $ do when alreadyInstalled $ do
case isolateDir of case installDir of
Just isoDir -> IsolateDir isoDir ->
lift $ logWarn $ "GHC " <> T.pack (prettyShow installVer) <> " already installed. Isolate installing to " <> T.pack isoDir lift $ logWarn $ "GHC " <> T.pack (prettyShow installVer) <> " already installed. Isolate installing to " <> T.pack isoDir
Nothing -> GHCupInternal ->
lift $ logWarn $ "GHC " <> T.pack (prettyShow installVer) <> " already installed. Will overwrite existing version." lift $ logWarn $ "GHC " <> T.pack (prettyShow installVer) <> " already installed. Will overwrite existing version."
lift $ logWarn lift $ logWarn
"...waiting for 10 seconds before continuing, you can still abort..." "...waiting for 10 seconds before continuing, you can still abort..."
liftIO $ threadDelay 10000000 -- give the user a sec to intervene liftIO $ threadDelay 10000000 -- give the user a sec to intervene
ghcdir <- case isolateDir of ghcdir <- case installDir of
Just isoDir -> pure isoDir IsolateDir isoDir -> pure $ IsolateDirResolved isoDir
Nothing -> lift $ ghcupGHCDir installVer GHCupInternal -> GHCupDir <$> lift (ghcupGHCDir installVer)
(mBindist, bmk) <- liftE $ runBuildAction (mBindist, bmk) <- liftE $ runBuildAction
tmpUnpack tmpUnpack
@@ -2243,8 +2261,8 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patches aargs buildFlavour hadr
pure (b, bmk) pure (b, bmk)
) )
case isolateDir of case installDir of
Nothing -> GHCupInternal ->
-- only remove old ghc in regular installs -- only remove old ghc in regular installs
when alreadyInstalled $ do when alreadyInstalled $ do
lift $ logInfo "Deleting existing installation" lift $ logInfo "Deleting existing installation"
@@ -2259,11 +2277,11 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patches aargs buildFlavour hadr
(installVer ^. tvVersion) (installVer ^. tvVersion)
False -- not a force install, since we already overwrite when compiling. False -- not a force install, since we already overwrite when compiling.
liftIO $ B.writeFile (ghcdir </> ghcUpSrcBuiltFile) bmk liftIO $ B.writeFile (fromInstallDir ghcdir </> ghcUpSrcBuiltFile) bmk
case isolateDir of case installDir of
-- set and make symlinks for regular (non-isolated) installs -- set and make symlinks for regular (non-isolated) installs
Nothing -> do GHCupInternal -> do
reThrowAll GHCupSetError $ postGHCInstall installVer reThrowAll GHCupSetError $ postGHCInstall installVer
-- restore -- restore
when alreadySet $ liftE $ void $ setGHC installVer SetGHCOnly Nothing when alreadySet $ liftE $ void $ setGHC installVer SetGHCOnly Nothing
@@ -2292,7 +2310,7 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patches aargs buildFlavour hadr
) )
=> GHCTargetVersion => GHCTargetVersion
-> FilePath -> FilePath
-> FilePath -> InstallDirResolved
-> Excepts -> Excepts
'[ FileDoesNotExistError '[ FileDoesNotExistError
, HadrianNotFound , HadrianNotFound
@@ -2351,7 +2369,7 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patches aargs buildFlavour hadr
) )
=> GHCTargetVersion => GHCTargetVersion
-> FilePath -> FilePath
-> FilePath -> InstallDirResolved
-> Excepts -> Excepts
'[ FileDoesNotExistError '[ FileDoesNotExistError
, HadrianNotFound , HadrianNotFound
@@ -2486,7 +2504,7 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patches aargs buildFlavour hadr
) )
=> GHCTargetVersion => GHCTargetVersion
-> FilePath -> FilePath
-> FilePath -> InstallDirResolved
-> Excepts -> Excepts
'[ FileDoesNotExistError '[ FileDoesNotExistError
, InvalidBuildConfig , InvalidBuildConfig
@@ -2497,7 +2515,7 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patches aargs buildFlavour hadr
] ]
m m
() ()
configureBindist tver workdir ghcdir = do configureBindist tver workdir (fromInstallDir -> ghcdir) = do
lift $ logInfo [s|configuring build|] lift $ logInfo [s|configuring build|]
if | _tvVersion tver >= [vver|8.8.0|] -> do if | _tvVersion tver >= [vver|8.8.0|] -> do
@@ -2587,6 +2605,7 @@ upgradeGHCup :: ( MonadMask m
=> Maybe FilePath -- ^ full file destination to write ghcup into => Maybe FilePath -- ^ full file destination to write ghcup into
-> Bool -- ^ whether to force update regardless -> Bool -- ^ whether to force update regardless
-- of currently installed version -- of currently installed version
-> Bool -- ^ whether to throw an error if ghcup is shadowed
-> Excepts -> Excepts
'[ CopyError '[ CopyError
, DigestError , DigestError
@@ -2595,15 +2614,16 @@ upgradeGHCup :: ( MonadMask m
, DownloadFailed , DownloadFailed
, NoDownload , NoDownload
, NoUpdate , NoUpdate
, GHCupShadowed
] ]
m m
Version Version
upgradeGHCup mtarget force' = do upgradeGHCup mtarget force' fatal = do
Dirs {..} <- lift getDirs Dirs {..} <- lift getDirs
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
lift $ logInfo "Upgrading GHCup..." lift $ logInfo "Upgrading GHCup..."
let latestVer = fromJust $ fst <$> getLatest dls GHCup let latestVer = fst (fromJust (getLatest dls GHCup))
(Just ghcupPVPVer) <- pure $ pvpToVersion ghcUpVer "" (Just ghcupPVPVer) <- pure $ pvpToVersion ghcUpVer ""
when (not force' && (latestVer <= ghcupPVPVer)) $ throwE NoUpdate when (not force' && (latestVer <= ghcupPVPVer)) $ throwE NoUpdate
dli <- liftE $ getDownloadInfo GHCup latestVer dli <- liftE $ getDownloadInfo GHCup latestVer
@@ -2625,14 +2645,17 @@ upgradeGHCup mtarget force' = do
lift $ logWarn $ T.pack (takeFileName destFile) <> " is not in PATH! You have to add it in order to use ghcup." lift $ logWarn $ T.pack (takeFileName destFile) <> " is not in PATH! You have to add it in order to use ghcup."
liftIO (isShadowed destFile) >>= \case liftIO (isShadowed destFile) >>= \case
Nothing -> pure () Nothing -> pure ()
Just pa -> lift $ logWarn $ "ghcup is shadowed by " Just pa
| fatal -> throwE (GHCupShadowed pa destFile latestVer)
| otherwise ->
lift $ logWarn $ "ghcup is shadowed by "
<> T.pack pa <> T.pack pa
<> ". The upgrade will not be in effect, unless you remove " <> ". The upgrade will not be in effect, unless you remove "
<> T.pack pa <> T.pack pa
<> " or make sure " <> " or make sure "
<> T.pack destDir <> T.pack destDir
<> " comes before " <> " comes before "
<> T.pack (takeFileName pa) <> T.pack (takeDirectory pa)
<> " in PATH." <> " in PATH."
pure latestVer pure latestVer

View File

@@ -27,6 +27,7 @@ import Data.CaseInsensitive ( CI )
import Data.Text ( Text ) import Data.Text ( Text )
import Data.Versions import Data.Versions
import Haskus.Utils.Variant import Haskus.Utils.Variant
import System.FilePath
import Text.PrettyPrint hiding ( (<>) ) import Text.PrettyPrint hiding ( (<>) )
import Text.PrettyPrint.HughesPJClass hiding ( (<>) ) import Text.PrettyPrint.HughesPJClass hiding ( (<>) )
import URI.ByteString import URI.ByteString
@@ -291,6 +292,24 @@ instance Pretty HadrianNotFound where
pPrint HadrianNotFound = pPrint HadrianNotFound =
text "Could not find Hadrian build files. Does this GHC version support Hadrian builds?" text "Could not find Hadrian build files. Does this GHC version support Hadrian builds?"
data GHCupShadowed = GHCupShadowed
FilePath -- shadow binary
FilePath -- upgraded binary
Version -- upgraded version
deriving Show
instance Pretty GHCupShadowed where
pPrint (GHCupShadowed sh up _) =
text ("ghcup is shadowed by "
<> sh
<> ". The upgrade will not be in effect, unless you remove "
<> sh
<> " or make sure "
<> takeDirectory up
<> " comes before "
<> takeDirectory sh
<> " in PATH."
)
------------------------- -------------------------
--[ High-level errors ]-- --[ High-level errors ]--

View File

@@ -628,3 +628,16 @@ data CapturedProcess = CapturedProcess
deriving (Eq, Show) deriving (Eq, Show)
makeLenses ''CapturedProcess makeLenses ''CapturedProcess
data InstallDir = IsolateDir FilePath
| GHCupInternal
deriving (Eq, Show)
data InstallDirResolved = IsolateDirResolved FilePath
| GHCupDir FilePath
deriving (Eq, Show)
fromInstallDir :: InstallDirResolved -> FilePath
fromInstallDir (IsolateDirResolved fp) = fp
fromInstallDir (GHCupDir fp) = fp

View File

@@ -317,10 +317,10 @@ ghcSet mtarget = do
MP.setInput rest MP.setInput rest
pure x pure x
) )
<* pathSep <* MP.some pathSep
<* MP.takeRest <* MP.takeRest
<* MP.eof <* MP.eof
ghcSubPath = pathSep <* MP.chunk "ghc" *> pathSep ghcSubPath = MP.some pathSep <* MP.chunk "ghc" *> MP.some pathSep
-- | Get all installed GHCs by reading ~/.ghcup/ghc/<dir>. -- | Get all installed GHCs by reading ~/.ghcup/ghc/<dir>.
-- If a dir cannot be parsed, returns left. -- If a dir cannot be parsed, returns left.
@@ -398,10 +398,10 @@ cabalSet = do
cabalParse = MP.chunk "cabal-" *> version' cabalParse = MP.chunk "cabal-" *> version'
-- parses any path component ending with path separator, -- parses any path component ending with path separator,
-- e.g. "foo/" -- e.g. "foo/"
stripPathComponet = parseUntil1 pathSep *> pathSep stripPathComponet = parseUntil1 pathSep *> MP.some pathSep
-- parses an absolute path up until the last path separator, -- parses an absolute path up until the last path separator,
-- e.g. "/bar/baz/foo" -> "/bar/baz/", leaving "foo" -- e.g. "/bar/baz/foo" -> "/bar/baz/", leaving "foo"
stripAbsolutePath = pathSep *> MP.many (MP.try stripPathComponet) stripAbsolutePath = MP.some pathSep *> MP.many (MP.try stripPathComponet)
-- parses a relative path up until the last path separator, -- parses a relative path up until the last path separator,
-- e.g. "bar/baz/foo" -> "bar/baz/", leaving "foo" -- e.g. "bar/baz/foo" -> "bar/baz/", leaving "foo"
stripRelativePath = MP.many (MP.try stripPathComponet) stripRelativePath = MP.many (MP.try stripPathComponet)
@@ -492,10 +492,10 @@ stackSet = do
cabalParse = MP.chunk "stack-" *> version' cabalParse = MP.chunk "stack-" *> version'
-- parses any path component ending with path separator, -- parses any path component ending with path separator,
-- e.g. "foo/" -- e.g. "foo/"
stripPathComponet = parseUntil1 pathSep *> pathSep stripPathComponet = parseUntil1 pathSep *> MP.some pathSep
-- parses an absolute path up until the last path separator, -- parses an absolute path up until the last path separator,
-- e.g. "/bar/baz/foo" -> "/bar/baz/", leaving "foo" -- e.g. "/bar/baz/foo" -> "/bar/baz/", leaving "foo"
stripAbsolutePath = pathSep *> MP.many (MP.try stripPathComponet) stripAbsolutePath = MP.some pathSep *> MP.many (MP.try stripPathComponet)
-- parses a relative path up until the last path separator, -- parses a relative path up until the last path separator,
-- e.g. "bar/baz/foo" -> "bar/baz/", leaving "foo" -- e.g. "bar/baz/foo" -> "bar/baz/", leaving "foo"
stripRelativePath = MP.many (MP.try stripPathComponet) stripRelativePath = MP.many (MP.try stripPathComponet)
@@ -543,10 +543,10 @@ hlsSet = do
cabalParse = MP.chunk "haskell-language-server-wrapper-" *> version' cabalParse = MP.chunk "haskell-language-server-wrapper-" *> version'
-- parses any path component ending with path separator, -- parses any path component ending with path separator,
-- e.g. "foo/" -- e.g. "foo/"
stripPathComponet = parseUntil1 pathSep *> pathSep stripPathComponet = parseUntil1 pathSep *> MP.some pathSep
-- parses an absolute path up until the last path separator, -- parses an absolute path up until the last path separator,
-- e.g. "/bar/baz/foo" -> "/bar/baz/", leaving "foo" -- e.g. "/bar/baz/foo" -> "/bar/baz/", leaving "foo"
stripAbsolutePath = pathSep *> MP.many (MP.try stripPathComponet) stripAbsolutePath = MP.some pathSep *> MP.many (MP.try stripPathComponet)
-- parses a relative path up until the last path separator, -- parses a relative path up until the last path separator,
-- e.g. "bar/baz/foo" -> "bar/baz/", leaving "foo" -- e.g. "bar/baz/foo" -> "bar/baz/", leaving "foo"
stripRelativePath = MP.many (MP.try stripPathComponet) stripRelativePath = MP.many (MP.try stripPathComponet)
@@ -1265,9 +1265,10 @@ ghcBinaryName (GHCTargetVersion Nothing _) = T.unpack ("ghc" <> T.pack exeExt)
installDestSanityCheck :: ( MonadIO m installDestSanityCheck :: ( MonadIO m
, MonadCatch m , MonadCatch m
) => ) =>
FilePath -> InstallDirResolved ->
Excepts '[DirNotEmpty] m () Excepts '[DirNotEmpty] m ()
installDestSanityCheck isoDir = do installDestSanityCheck (IsolateDirResolved isoDir) = do
hideErrorDef [doesNotExistErrorType] () $ do hideErrorDef [doesNotExistErrorType] () $ do
contents <- liftIO $ getDirectoryContentsRecursive isoDir contents <- liftIO $ getDirectoryContentsRecursive isoDir
unless (null contents) (throwE $ DirNotEmpty isoDir) unless (null contents) (throwE $ DirNotEmpty isoDir)
installDestSanityCheck _ = pure ()

View File

@@ -16,6 +16,7 @@
# * BOOTSTRAP_HASKELL_INSTALL_HLS - whether to install latest hls # * BOOTSTRAP_HASKELL_INSTALL_HLS - whether to install latest hls
# * BOOTSTRAP_HASKELL_ADJUST_BASHRC - whether to adjust PATH in bashrc (prepend) # * BOOTSTRAP_HASKELL_ADJUST_BASHRC - whether to adjust PATH in bashrc (prepend)
# * BOOTSTRAP_HASKELL_ADJUST_CABAL_CONFIG - whether to adjust mingw paths in cabal.config on windows # * BOOTSTRAP_HASKELL_ADJUST_CABAL_CONFIG - whether to adjust mingw paths in cabal.config on windows
# * GHCUP_BASE_URL - the base url for ghcup binary download (use this to overwrite https://downloads.haskell.org/~ghcup with a mirror)
# License: LGPL-3.0 # License: LGPL-3.0
@@ -25,8 +26,8 @@
plat="$(uname -s)" plat="$(uname -s)"
arch=$(uname -m) arch=$(uname -m)
ghver="0.1.17.6" ghver="0.1.17.7"
base_url="https://downloads.haskell.org/~ghcup" : "${GHCUP_BASE_URL:=https://downloads.haskell.org/~ghcup}"
export GHCUP_SKIP_UPDATE_CHECK=yes export GHCUP_SKIP_UPDATE_CHECK=yes
@@ -235,26 +236,26 @@ download_ghcup() {
# we could be in a 32bit docker container, in which # we could be in a 32bit docker container, in which
# case uname doesn't give us what we want # case uname doesn't give us what we want
if [ "$(getconf LONG_BIT)" = "32" ] ; then if [ "$(getconf LONG_BIT)" = "32" ] ; then
_url=${base_url}/${ghver}/i386-linux-ghcup-${ghver} _url=${GHCUP_BASE_URL}/${ghver}/i386-linux-ghcup-${ghver}
elif [ "$(getconf LONG_BIT)" = "64" ] ; then elif [ "$(getconf LONG_BIT)" = "64" ] ; then
_url=${base_url}/${ghver}/x86_64-linux-ghcup-${ghver} _url=${GHCUP_BASE_URL}/${ghver}/x86_64-linux-ghcup-${ghver}
else else
die "Unknown long bit size: $(getconf LONG_BIT)" die "Unknown long bit size: $(getconf LONG_BIT)"
fi fi
;; ;;
i*86) i*86)
_url=${base_url}/${ghver}/i386-linux-ghcup-${ghver} _url=${GHCUP_BASE_URL}/${ghver}/i386-linux-ghcup-${ghver}
;; ;;
armv7*|*armv8l*) armv7*|*armv8l*)
_url=${base_url}/${ghver}/armv7-linux-ghcup-${ghver} _url=${GHCUP_BASE_URL}/${ghver}/armv7-linux-ghcup-${ghver}
;; ;;
aarch64|arm64) aarch64|arm64)
# we could be in a 32bit docker container, in which # we could be in a 32bit docker container, in which
# case uname doesn't give us what we want # case uname doesn't give us what we want
if [ "$(getconf LONG_BIT)" = "32" ] ; then if [ "$(getconf LONG_BIT)" = "32" ] ; then
_url=${base_url}/${ghver}/armv7-linux-ghcup-${ghver} _url=${GHCUP_BASE_URL}/${ghver}/armv7-linux-ghcup-${ghver}
elif [ "$(getconf LONG_BIT)" = "64" ] ; then elif [ "$(getconf LONG_BIT)" = "64" ] ; then
_url=${base_url}/${ghver}/aarch64-linux-ghcup-${ghver} _url=${GHCUP_BASE_URL}/${ghver}/aarch64-linux-ghcup-${ghver}
else else
die "Unknown long bit size: $(getconf LONG_BIT)" die "Unknown long bit size: $(getconf LONG_BIT)"
fi fi
@@ -281,15 +282,15 @@ download_ghcup() {
*) die "Unknown architecture: ${arch}" *) die "Unknown architecture: ${arch}"
;; ;;
esac esac
_url=${base_url}/${ghver}/x86_64-freebsd${freebsd_ver}-ghcup-${ghver} _url=${GHCUP_BASE_URL}/${ghver}/x86_64-freebsd${freebsd_ver}-ghcup-${ghver}
;; ;;
"Darwin"|"darwin") "Darwin"|"darwin")
case "${arch}" in case "${arch}" in
x86_64|amd64) x86_64|amd64)
_url=${base_url}/${ghver}/x86_64-apple-darwin-ghcup-${ghver} _url=${GHCUP_BASE_URL}/${ghver}/x86_64-apple-darwin-ghcup-${ghver}
;; ;;
aarch64|arm64|armv8l) aarch64|arm64|armv8l)
_url=${base_url}/${ghver}/aarch64-apple-darwin-ghcup-${ghver} _url=${GHCUP_BASE_URL}/${ghver}/aarch64-apple-darwin-ghcup-${ghver}
;; ;;
i*86) i*86)
die "i386 currently not supported!" die "i386 currently not supported!"
@@ -301,7 +302,7 @@ download_ghcup() {
MSYS*|MINGW*) MSYS*|MINGW*)
case "${arch}" in case "${arch}" in
x86_64|amd64) x86_64|amd64)
_url=${base_url}/${ghver}/x86_64-mingw64-ghcup-${ghver}.exe _url=${GHCUP_BASE_URL}/${ghver}/x86_64-mingw64-ghcup-${ghver}.exe
;; ;;
*) die "Unknown architecture: ${arch}" *) die "Unknown architecture: ${arch}"
;; ;;

View File

@@ -239,7 +239,27 @@ if ($Silent -and !($InstallDir)) {
} }
} else { } else {
while ($true) { while ($true) {
Print-Msg -color Magenta -msg ('Where to install to (this should be a short Path, preferably a Drive like ''C:\''){1}Press enter to accept the default [{0}]:' -f $defaultGhcupBasePrefix, "`n") Print-Msg -color Magenta -msg (@'
Welcome to Haskell!
This script will 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
* cabal - The Cabal build tool for managing Haskell software
* stack - (optional) A cross-platform program for developing Haskell projects
* hls - (optional) A language server for developers to integrate with their editor/IDE
Please note that ANTIVIRUS may interfere with the installation. If you experience problems, consider
disabling it temporarily.
Where to install to (this should be a short Path, preferably a Drive like 'C:\')?
If you accept this path, binaries will be installed into '{0}ghcup\bin' and msys2 into '{0}ghcup\msys64'.
Press enter to accept the default [{0}]:
'@ -f $defaultGhcupBasePrefix)
$basePrefixPrompt = Read-Host $basePrefixPrompt = Read-Host
$GhcupBasePrefix = ($defaultGhcupBasePrefix,$basePrefixPrompt)[[bool]$basePrefixPrompt] $GhcupBasePrefix = ($defaultGhcupBasePrefix,$basePrefixPrompt)[[bool]$basePrefixPrompt]
if (!($GhcupBasePrefix.EndsWith('\'))) { if (!($GhcupBasePrefix.EndsWith('\'))) {

View File

@@ -1,4 +1,4 @@
resolver: lts-18.27 resolver: lts-18.28
packages: packages:
- . - .