Compare commits
20 Commits
| Author | SHA1 | Date | |
|---|---|---|---|
|
6d76561340
|
|||
|
00caeba067
|
|||
|
5a34191b88
|
|||
|
85003900d7
|
|||
|
0c666a6bbe
|
|||
|
e4e52ebf6b
|
|||
|
4512468108
|
|||
|
d3e3ebd63f
|
|||
|
ce616d3eb3
|
|||
|
5837e04e6e
|
|||
|
95ca79f3f8
|
|||
|
706fe1ffcc
|
|||
|
2774f026e8
|
|||
|
07604a2eb5
|
|||
|
1dc9ad7a57
|
|||
|
cc51d7b454
|
|||
|
c439693a8f
|
|||
|
af8c097092
|
|||
|
928f4a97de
|
|||
|
abbe51614d
|
@@ -104,6 +104,7 @@ variables:
|
||||
expire_in: 2 week
|
||||
paths:
|
||||
- golden
|
||||
- dist-newstyle/cache/
|
||||
when: on_failure
|
||||
|
||||
# .test_ghcup_scoop:
|
||||
@@ -202,6 +203,7 @@ variables:
|
||||
expire_in: 2 week
|
||||
paths:
|
||||
- out
|
||||
- dist-newstyle/cache/
|
||||
only:
|
||||
- tags
|
||||
variables:
|
||||
|
||||
17
CHANGELOG.md
17
CHANGELOG.md
@@ -1,8 +1,23 @@
|
||||
# Revision history for ghcup
|
||||
|
||||
## 0.1.16 -- ????-??-??
|
||||
## 0.1.16 -- 2021-07-28
|
||||
|
||||
* Add 'nuke' subcommand wrt [#135](https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/135), implemented by Arjun Kathuria
|
||||
* Add uninstallation powershell script on windows wrt [#150](https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/150)
|
||||
* Improve logging
|
||||
* Fix building GHC cross compiler wrt [#180](https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/180)
|
||||
* Allow to use hadrian as build system (for git based versions only) wrt [#35](https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/35)
|
||||
* Allow passing `--flavor` to `ghcup compile ghc`
|
||||
* Support new GHC `bin/` directory format wrt [ghc/ghc#20074](https://gitlab.haskell.org/ghc/ghc/-/issues/20074#note_363720)
|
||||
* Implement `whereis` subcommand wrt [#173](https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/173)
|
||||
* Add `--offline` switch and `prefetch` subcommand wrt [#186](https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/186)
|
||||
* Implement ETAGs hashing for metadata downloads to speed up `ghcup list` wrt [#193](https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/193)
|
||||
* Avoid unnecessary fetching of ghcup metadata in some commands
|
||||
* Avoid unnecessary update checks for some commands
|
||||
* Preserve mtimes on unpacked GHC tarballs on windows wrt [#187](https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/187), fixing issues with `ghc-pkg`
|
||||
* Fix lesser bug in `ghcup list` for stray stack versions wrt [#183](https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/183)
|
||||
* Major redo on how file removal on windows works, avoiding partial removals etc, wrt [#165](https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/165)
|
||||
* Improve ghcup tui for screen readers wrt [github/#4](https://github.com/haskell/ghcup-hs/pull/4), thanks to Mario Lang
|
||||
|
||||
## 0.1.15.2 -- 2021-06-13
|
||||
|
||||
|
||||
@@ -126,7 +126,7 @@ validate dls _ = do
|
||||
_ -> lift $ $(logWarn) [i|Linux Alpine missing for #{t} #{v'} #{arch'}|]
|
||||
|
||||
checkUniqueTags tool = do
|
||||
let allTags = join $ M.elems $ availableToolVersions dls tool
|
||||
let allTags = join $ fmap _viTags $ M.elems $ availableToolVersions dls tool
|
||||
let nonUnique =
|
||||
fmap fst
|
||||
. filter (\(_, b) -> not b)
|
||||
@@ -164,7 +164,7 @@ validate dls _ = do
|
||||
|
||||
-- a tool must have at least one of each mandatory tags
|
||||
checkMandatoryTags tool = do
|
||||
let allTags = join $ M.elems $ availableToolVersions dls tool
|
||||
let allTags = join $ fmap _viTags $ M.elems $ availableToolVersions dls tool
|
||||
forM_ [Latest, Recommended] $ \t -> case elem t allTags of
|
||||
False -> do
|
||||
lift $ $(logError) [i|Tag #{t} missing from #{tool}|]
|
||||
@@ -174,7 +174,7 @@ validate dls _ = do
|
||||
-- all GHC versions must have a base tag
|
||||
checkGHCHasBaseVersion = do
|
||||
let allTags = M.toList $ availableToolVersions dls GHC
|
||||
forM allTags $ \(ver, tags) -> case any isBase tags of
|
||||
forM allTags $ \(ver, _viTags -> tags) -> case any isBase tags of
|
||||
False -> do
|
||||
lift $ $(logError) [i|Base tag missing from GHC ver #{ver}|]
|
||||
addError
|
||||
|
||||
@@ -1061,6 +1061,7 @@ tagCompleter tool add = listIOCompleter $ do
|
||||
VRight ghcupInfo -> do
|
||||
let allTags = filter (\t -> t /= Old)
|
||||
$ join
|
||||
$ fmap _viTags
|
||||
$ M.elems
|
||||
$ availableToolVersions (_ghcupDownloads ghcupInfo) tool
|
||||
pure $ nub $ (add ++) $ fmap tagToString allTags
|
||||
@@ -1390,9 +1391,18 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
||||
race_ (liftIO $ runLogger $ flip runReaderT dirs $ cleanupTrash)
|
||||
(threadDelay 5000000 >> runLogger ($(logWarn) [i|Killing cleanup thread (exceeded 5s timeout)... please remove leftover files in #{recycleDir} manually|]))
|
||||
|
||||
lookupEnv "GHCUP_SKIP_UPDATE_CHECK" >>= \case
|
||||
Nothing -> runLogger $ flip runReaderT s' $ checkForUpdates
|
||||
Just _ -> pure ()
|
||||
case optCommand of
|
||||
Nuke -> pure ()
|
||||
Whereis _ _ -> pure ()
|
||||
DInfo -> pure ()
|
||||
ToolRequirements -> pure ()
|
||||
ChangeLog _ -> pure ()
|
||||
#if defined(BRICK)
|
||||
Interactive -> pure ()
|
||||
#endif
|
||||
_ -> lookupEnv "GHCUP_SKIP_UPDATE_CHECK" >>= \case
|
||||
Nothing -> runLogger $ flip runReaderT s' $ checkForUpdates
|
||||
Just _ -> pure ()
|
||||
|
||||
-- TODO: always run for windows
|
||||
(siletRunLogger $ flip runReaderT s' $ runE ensureGlobalTools) >>= \case
|
||||
@@ -2017,22 +2027,25 @@ Make sure to clean up #{tmpdir} afterwards.|])
|
||||
(UpgradeAt p) -> pure $ Just p
|
||||
UpgradeGHCupDir -> pure (Just (binDir </> "ghcup" <> exeExt))
|
||||
|
||||
runUpgrade (liftE $ upgradeGHCup target force') >>= \case
|
||||
VRight v' -> do
|
||||
GHCupInfo { _ghcupDownloads = dls } <- runAppState getGHCupInfo
|
||||
let pretty_v = prettyVer v'
|
||||
let vi = fromJust $ snd <$> getLatest dls GHCup
|
||||
runLogger $ $(logInfo)
|
||||
[i|Successfully upgraded GHCup to version #{pretty_v}|]
|
||||
forM_ (_viPostInstall vi) $ \msg ->
|
||||
runLogger $ $(logInfo) msg
|
||||
pure ExitSuccess
|
||||
VLeft (V NoUpdate) -> do
|
||||
runLogger $ $(logWarn) [i|No GHCup update available|]
|
||||
pure ExitSuccess
|
||||
VLeft e -> do
|
||||
runLogger $ $(logError) $ T.pack $ prettyShow e
|
||||
pure $ ExitFailure 11
|
||||
runUpgrade (do
|
||||
v' <- liftE $ upgradeGHCup target force'
|
||||
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
||||
pure (v', dls)
|
||||
) >>= \case
|
||||
VRight (v', dls) -> do
|
||||
let pretty_v = prettyVer v'
|
||||
let vi = fromJust $ snd <$> getLatest dls GHCup
|
||||
runLogger $ $(logInfo)
|
||||
[i|Successfully upgraded GHCup to version #{pretty_v}|]
|
||||
forM_ (_viPostInstall vi) $ \msg ->
|
||||
runLogger $ $(logInfo) msg
|
||||
pure ExitSuccess
|
||||
VLeft (V NoUpdate) -> do
|
||||
runLogger $ $(logWarn) [i|No GHCup update available|]
|
||||
pure ExitSuccess
|
||||
VLeft e -> do
|
||||
runLogger $ $(logError) $ T.pack $ prettyShow e
|
||||
pure $ ExitFailure 11
|
||||
|
||||
ToolRequirements -> do
|
||||
s' <- appState
|
||||
@@ -2116,7 +2129,7 @@ Make sure to clean up #{tmpdir} afterwards.|])
|
||||
runLogger $ $logInfo "Nuclear Annihilation complete!"
|
||||
pure ExitSuccess
|
||||
| otherwise -> do
|
||||
runLogger $ $logWarn "These Files have survived Nuclear Annihilation, you may remove them manually."
|
||||
runLogger $ $logError "These Files have survived Nuclear Annihilation, you may remove them manually."
|
||||
forM_ leftOverFiles putStrLn
|
||||
pure ExitSuccess
|
||||
|
||||
|
||||
@@ -276,7 +276,7 @@ if ($CabalDir) {
|
||||
while ($true) {
|
||||
|
||||
$defaultCabalDir = ('{0}\cabal' -f $GhcupBasePrefix)
|
||||
Print-Msg -color Magenta -msg ('Specify Cabal directory (this is where haskell packages end up). Press enter to accept the default [{0}]:' -f $defaultCabalDir)
|
||||
Print-Msg -color Magenta -msg ('Specify Cabal directory (this is where haskell packages end up){1}Press enter to accept the default [{0}]:' -f $defaultCabalDir, "`n")
|
||||
$CabalDirPrompt = Read-Host
|
||||
$CabDirEnv = ($defaultCabalDir,$CabalDirPrompt)[[bool]$CabalDirPrompt]
|
||||
|
||||
@@ -383,7 +383,7 @@ if (!(Test-Path -Path ('{0}' -f $MsysDir))) {
|
||||
while ($true) {
|
||||
if ($GhcupMsys2) {
|
||||
$defaultMsys2Dir = $GhcupMsys2
|
||||
Print-Msg -color Magenta -msg ('Input existing MSys2 toolchain directory. Press enter to accept the default [{0}]:' -f $defaultMsys2Dir)
|
||||
Print-Msg -color Magenta -msg ('Input existing MSys2 toolchain directory.{1}Press enter to accept the default [{0}]:' -f $defaultMsys2Dir, "`n")
|
||||
$MsysDirPrompt = Read-Host
|
||||
$MsysDir = ($defaultMsys2Dir,$MsysDirPrompt)[[bool]$MsysDirPrompt]
|
||||
} else {
|
||||
@@ -412,11 +412,74 @@ if (!(Test-Path -Path ('{0}' -f $MsysDir))) {
|
||||
}
|
||||
|
||||
Print-Msg -msg 'Creating shortcuts...'
|
||||
$uninstallShortCut = @'
|
||||
$decision = $Host.UI.PromptForChoice('Uninstall Haskell'
|
||||
, 'Do you want to uninstall all of the haskell toolchain, including GHC, Cabal, Stack and GHCup itself?'
|
||||
, [System.Management.Automation.Host.ChoiceDescription[]] @('&Uninstall'
|
||||
'&Abort'), 0)
|
||||
|
||||
if ($decision -eq 1) {
|
||||
Exit 0
|
||||
}
|
||||
|
||||
Write-Host 'Removing ghcup toolchain' -ForegroundColor Green
|
||||
ghcup nuke
|
||||
|
||||
Write-Host 'Unsetting GHCUP_INSTALL_BASE_PREFIX' -ForegroundColor Green
|
||||
[Environment]::SetEnvironmentVariable('GHCUP_INSTALL_BASE_PREFIX', $null, [System.EnvironmentVariableTarget]::User)
|
||||
|
||||
$ghcupMsys2 = [System.Environment]::GetEnvironmentVariable('GHCUP_MSYS2', 'user')
|
||||
$GhcupBasePrefixEnv = [System.Environment]::GetEnvironmentVariable('GHCUP_INSTALL_BASE_PREFIX', 'user')
|
||||
|
||||
if ($ghcupMsys2) {
|
||||
$msys2Dir = [IO.Path]::GetFullPath($ghcupMsys2)
|
||||
$baseDir = [IO.Path]::GetFullPath('{0}\ghcup' -f $GhcupBasePrefixEnv)
|
||||
|
||||
if ($msys2Dir.StartsWith($baseDir)) {
|
||||
Write-Host 'Unsetting GHCUP_MSYS2' -ForegroundColor Green
|
||||
[Environment]::SetEnvironmentVariable('GHCUP_MSYS2', $null, [System.EnvironmentVariableTarget]::User)
|
||||
} else {
|
||||
Write-Host ('GHCUP_MSYS2 env variable is set to a non-standard location {0}. Environment variable not unset. Uninstall manually.' -f $msys2Dir) -ForegroundColor Magenta
|
||||
}
|
||||
} else {
|
||||
Write-Host 'Unsetting GHCUP_MSYS2' -ForegroundColor Green
|
||||
[Environment]::SetEnvironmentVariable('GHCUP_MSYS2', $null, [System.EnvironmentVariableTarget]::User)
|
||||
}
|
||||
|
||||
Write-Host 'Removing ghcup from PATH env var' -ForegroundColor Green
|
||||
$path = [System.Environment]::GetEnvironmentVariable(
|
||||
'PATH',
|
||||
'user'
|
||||
)
|
||||
$path = ($path.Split(';') | Where-Object { $_ -ne ('{0}\bin' -f $baseDir) }) -join ';'
|
||||
[System.Environment]::SetEnvironmentVariable(
|
||||
'PATH',
|
||||
$path,
|
||||
'user'
|
||||
)
|
||||
|
||||
Write-Host 'Removing desktop files' -ForegroundColor Green
|
||||
$DesktopDir = [Environment]::GetFolderPath("Desktop")
|
||||
Remove-Item -LiteralPath ('{0}\Install GHC dev dependencies.lnk' -f $DesktopDir) -Force
|
||||
Remove-Item -LiteralPath ('{0}\Mingw haskell shell.lnk' -f $DesktopDir) -Force
|
||||
Remove-Item -LiteralPath ('{0}\Mingw package management docs.url' -f $DesktopDir) -Force
|
||||
|
||||
Write-Host ('CABAL_DIR env variable is still set to {0} and will be used by cabal regardless of ghcup. You may want to uninstall this manually.' -f [System.Environment]::GetEnvironmentVariable('CABAL_DIR', 'user')) -ForegroundColor Magenta
|
||||
Write-Host 'You may remove this script now.' -ForegroundColor Magenta
|
||||
|
||||
if ($Host.Name -eq "ConsoleHost")
|
||||
{
|
||||
Write-Host "Press any key to continue..."
|
||||
$Host.UI.RawUI.ReadKey("NoEcho,IncludeKeyUp") > $null
|
||||
}
|
||||
'@
|
||||
|
||||
$DesktopDir = [Environment]::GetFolderPath("Desktop")
|
||||
$GhcInstArgs = '-mingw64 -mintty -c "pacman --noconfirm -S --needed base-devel gettext autoconf make libtool automake python p7zip patch unzip"'
|
||||
Create-Shortcut -SourceExe ('{0}\msys2_shell.cmd' -f $MsysDir) -ArgumentsToSourceExe $GhcInstArgs -DestinationPath ('{0}\Install GHC dev dependencies.lnk' -f $DesktopDir)
|
||||
Create-Shortcut -SourceExe ('{0}\msys2_shell.cmd' -f $MsysDir) -ArgumentsToSourceExe '-mingw64' -DestinationPath ('{0}\Mingw haskell shell.lnk' -f $DesktopDir)
|
||||
Create-Shortcut -SourceExe 'https://www.msys2.org/docs/package-management' -ArgumentsToSourceExe '' -DestinationPath ('{0}\Mingw package management docs.url' -f $DesktopDir)
|
||||
$null = New-Item -Path $DesktopDir -Name "Uninstall Haskell.ps1" -ItemType "file" -Force -Value $uninstallShortCut
|
||||
|
||||
Print-Msg -msg ('Adding {0}\bin to Users Path...' -f $GhcupDir)
|
||||
Add-EnvPath -Path ('{0}\bin' -f ([System.IO.Path]::GetFullPath("$GhcupDir"))) -Container 'User'
|
||||
|
||||
@@ -96,6 +96,7 @@ toolRequirements:
|
||||
Linux_Alpine:
|
||||
unknown_versioning:
|
||||
distroPKGs:
|
||||
- binutils-gold
|
||||
- curl
|
||||
- gcc
|
||||
- g++
|
||||
@@ -2075,7 +2076,10 @@ ghcupDownloads:
|
||||
1.1.0:
|
||||
viTags: []
|
||||
viChangeLog: https://github.com/haskell/haskell-language-server/blob/master/ChangeLog.md#110
|
||||
viPostInstall: "This is just the server part of your LSP configuration. Consult the README on how to configure HLS, your project and your LSP client in your editor: https://github.com/haskell/haskell-language-server/blob/master/README.md"
|
||||
viPostInstall: &hls-post-install |
|
||||
This is just the server part of your LSP configuration. Consult the README on how to
|
||||
configure HLS, your project and your LSP client in your editor:
|
||||
https://github.com/haskell/haskell-language-server/blob/master/README.md
|
||||
viArch:
|
||||
A_64:
|
||||
Linux_UnknownLinux:
|
||||
@@ -2097,7 +2101,7 @@ ghcupDownloads:
|
||||
- Recommended
|
||||
- Latest
|
||||
viChangeLog: https://github.com/haskell/haskell-language-server/blob/master/ChangeLog.md#120
|
||||
viPostInstall: "This is just the server part of your LSP configuration. Consult the README on how to configure HLS, your project and your LSP client in your editor: https://github.com/haskell/haskell-language-server/blob/master/README.md"
|
||||
viPostInstall: *hls-post-install
|
||||
viArch:
|
||||
A_64:
|
||||
Linux_UnknownLinux:
|
||||
|
||||
@@ -1,6 +1,6 @@
|
||||
cabal-version: 3.0
|
||||
name: ghcup
|
||||
version: 0.1.15.2
|
||||
version: 0.1.16
|
||||
license: LGPL-3.0-only
|
||||
license-file: LICENSE
|
||||
copyright: Julian Ospald 2020
|
||||
|
||||
45
lib/GHCup.hs
45
lib/GHCup.hs
@@ -965,9 +965,9 @@ data ListResult = ListResult
|
||||
|
||||
|
||||
-- | Extract all available tool versions and their tags.
|
||||
availableToolVersions :: GHCupDownloads -> Tool -> Map.Map Version [Tag]
|
||||
availableToolVersions :: GHCupDownloads -> Tool -> Map.Map Version VersionInfo
|
||||
availableToolVersions av tool = view
|
||||
(at tool % non Map.empty % to (fmap _viTags))
|
||||
(at tool % non Map.empty)
|
||||
av
|
||||
|
||||
|
||||
@@ -1018,7 +1018,9 @@ listVersions lt' criteria = do
|
||||
Stack -> do
|
||||
slr <- strayStacks avTools sSet stacks
|
||||
pure (sort (slr ++ lr))
|
||||
GHCup -> pure lr
|
||||
GHCup -> do
|
||||
let cg = currentGHCup avTools
|
||||
pure (sort (cg : lr))
|
||||
Nothing -> do
|
||||
ghcvers <- go (Just GHC) cSet cabals hlsSet' hlses sSet stacks
|
||||
cabalvers <- go (Just Cabal) cSet cabals hlsSet' hlses sSet stacks
|
||||
@@ -1033,7 +1035,7 @@ listVersions lt' criteria = do
|
||||
, MonadLogger m
|
||||
, MonadIO m
|
||||
)
|
||||
=> Map.Map Version [Tag]
|
||||
=> Map.Map Version VersionInfo
|
||||
-> m [ListResult]
|
||||
strayGHCs avTools = do
|
||||
ghcs <- getInstalledGHCs
|
||||
@@ -1081,7 +1083,7 @@ listVersions lt' criteria = do
|
||||
, MonadLogger m
|
||||
, MonadIO m
|
||||
)
|
||||
=> Map.Map Version [Tag]
|
||||
=> Map.Map Version VersionInfo
|
||||
-> Maybe Version
|
||||
-> [Either FilePath Version]
|
||||
-> m [ListResult]
|
||||
@@ -1115,7 +1117,7 @@ listVersions lt' criteria = do
|
||||
, MonadThrow m
|
||||
, MonadLogger m
|
||||
, MonadIO m)
|
||||
=> Map.Map Version [Tag]
|
||||
=> Map.Map Version VersionInfo
|
||||
-> Maybe Version
|
||||
-> [Either FilePath Version]
|
||||
-> m [ListResult]
|
||||
@@ -1150,7 +1152,7 @@ listVersions lt' criteria = do
|
||||
, MonadLogger m
|
||||
, MonadIO m
|
||||
)
|
||||
=> Map.Map Version [Tag]
|
||||
=> Map.Map Version VersionInfo
|
||||
-> Maybe Version
|
||||
-> [Either FilePath Version]
|
||||
-> m [ListResult]
|
||||
@@ -1178,6 +1180,25 @@ listVersions lt' criteria = do
|
||||
[i|Could not parse version of stray directory #{e}|]
|
||||
pure Nothing
|
||||
|
||||
currentGHCup :: Map.Map Version VersionInfo -> ListResult
|
||||
currentGHCup av =
|
||||
let currentVer = pvpToVersion ghcUpVer
|
||||
listVer = Map.lookup currentVer av
|
||||
latestVer = fst <$> headOf (getTagged Latest) av
|
||||
recommendedVer = fst <$> headOf (getTagged Latest) av
|
||||
isOld = maybe True (> currentVer) latestVer && maybe True (> currentVer) recommendedVer
|
||||
in ListResult { lVer = currentVer
|
||||
, lTag = maybe (if isOld then [Old] else []) _viTags listVer
|
||||
, lCross = Nothing
|
||||
, lTool = GHCup
|
||||
, fromSrc = False
|
||||
, lStray = isNothing listVer
|
||||
, lSet = True
|
||||
, lInstalled = True
|
||||
, lNoBindist = False
|
||||
, hlsPowered = False
|
||||
}
|
||||
|
||||
-- NOTE: this are not cross ones, because no bindists
|
||||
toListResult :: ( MonadLogger m
|
||||
, MonadReader env m
|
||||
@@ -1194,9 +1215,9 @@ listVersions lt' criteria = do
|
||||
-> [Either FilePath Version]
|
||||
-> Maybe Version
|
||||
-> [Either FilePath Version]
|
||||
-> (Version, [Tag])
|
||||
-> (Version, VersionInfo)
|
||||
-> m ListResult
|
||||
toListResult t cSet cabals hlsSet' hlses stackSet' stacks (v, tags) = do
|
||||
toListResult t cSet cabals hlsSet' hlses stackSet' stacks (v, _viTags -> tags) = do
|
||||
case t of
|
||||
GHC -> do
|
||||
lNoBindist <- fmap (isLeft . veitherToEither) $ runE @'[NoDownload] $ getDownloadInfo GHC v
|
||||
@@ -1537,18 +1558,18 @@ rmGhcupDirs = do
|
||||
|
||||
where
|
||||
handleRm :: (MonadCatch m, MonadLogger m) => m () -> m ()
|
||||
handleRm = handleIO (\e -> $logWarn [i|Part of the cleanup action failed with error: #{displayException e}
|
||||
handleRm = handleIO (\e -> $logDebug [i|Part of the cleanup action failed with error: #{displayException e}
|
||||
continuing regardless...|])
|
||||
|
||||
rmEnvFile :: (MonadLogger m, MonadReader env m, HasDirs env, MonadMask m, MonadIO m, MonadCatch m) => FilePath -> m ()
|
||||
rmEnvFile enFilePath = do
|
||||
$logInfo "Removing Ghcup Environment File"
|
||||
deleteFile enFilePath
|
||||
hideErrorDef [permissionErrorType] () $ deleteFile enFilePath
|
||||
|
||||
rmConfFile :: (MonadLogger m, MonadReader env m, HasDirs env, MonadMask m, MonadIO m, MonadCatch m) => FilePath -> m ()
|
||||
rmConfFile confFilePath = do
|
||||
$logInfo "removing Ghcup Config File"
|
||||
deleteFile confFilePath
|
||||
hideErrorDef [permissionErrorType] () $ deleteFile confFilePath
|
||||
|
||||
rmDir :: (MonadLogger m, MonadReader env m, HasDirs env, MonadMask m, MonadIO m, MonadCatch m) => FilePath -> m ()
|
||||
rmDir dir =
|
||||
|
||||
@@ -766,49 +766,22 @@ ghcToolFiles ver = do
|
||||
whenM (fmap not $ liftIO $ doesDirectoryExist ghcdir)
|
||||
(throwE (NotInstalled GHC ver))
|
||||
|
||||
files <- liftIO $ listDirectory bindir
|
||||
-- figure out the <ver> suffix, because this might not be `Version` for
|
||||
-- alpha/rc releases, but x.y.a.somedate.
|
||||
files <- liftIO (listDirectory bindir >>= filterM (doesFileExist . (bindir </>)))
|
||||
pure (getUniqueTools . groupToolFiles . fmap (dropSuffix exeExt) $ files)
|
||||
|
||||
ghcIsHadrian <- liftIO $ isHadrian bindir
|
||||
onlyUnversioned <- case ghcIsHadrian of
|
||||
Right () -> pure id
|
||||
Left (fmap (dropSuffix exeExt) -> [ghc, ghc_ver])
|
||||
| (Just symver) <- stripPrefix (ghc <> "-") ghc_ver
|
||||
, not (null symver) -> pure $ filter (\x -> not $ symver `isInfixOf` x)
|
||||
_ -> fail "Fatal: Could not find internal GHC version"
|
||||
|
||||
pure $ onlyUnversioned $ fmap (dropSuffix exeExt) files
|
||||
where
|
||||
isNotAnyInfix xs t = foldr (\a b -> not (a `isInfixOf` t) && b) True xs
|
||||
-- GHC is moving some builds to Hadrian for bindists,
|
||||
-- which doesn't create versioned binaries.
|
||||
-- https://gitlab.haskell.org/haskell/ghcup-hs/issues/31
|
||||
isHadrian :: FilePath -- ^ ghcbin path
|
||||
-> IO (Either [String] ()) -- ^ Right for Hadrian
|
||||
isHadrian dir = do
|
||||
-- Non-hadrian has e.g. ["ghc", "ghc-8.10.4"]
|
||||
-- which also requires us to discover the internal version
|
||||
-- to filter the correct tool files.
|
||||
-- We can't use the symlink on windows, so we fall back to some
|
||||
-- more complicated logic.
|
||||
fs <- fmap
|
||||
-- regex over-matches
|
||||
(filter (isNotAnyInfix ["haddock", "ghc-pkg", "ghci"]))
|
||||
$ liftIO $ findFiles
|
||||
dir
|
||||
(makeRegexOpts compExtended
|
||||
execBlank
|
||||
-- for cross, this won't be "ghc", but e.g.
|
||||
-- "armv7-unknown-linux-gnueabihf-ghc"
|
||||
([s|^([a-zA-Z0-9_-]*[a-zA-Z0-9_]-)?ghc.*$|] :: ByteString)
|
||||
)
|
||||
if | length fs == 1 -> pure $ Right () -- hadrian
|
||||
| length fs == 2 -> pure $ Left
|
||||
(sortOn length fs) -- legacy make, result should
|
||||
-- be ["ghc", "ghc-8.10.4"]
|
||||
| otherwise -> fail "isHadrian failed!"
|
||||
|
||||
groupToolFiles :: [FilePath] -> [[(FilePath, String)]]
|
||||
groupToolFiles = groupBy (\(a, _) (b, _) -> a == b) . fmap (splitOnPVP "-")
|
||||
|
||||
getUniqueTools :: [[(FilePath, String)]] -> [String]
|
||||
getUniqueTools = filter (isNotAnyInfix blackListedTools) . nub . fmap fst . filter ((== "") . snd) . concat
|
||||
|
||||
blackListedTools :: [String]
|
||||
blackListedTools = ["haddock-ghc"]
|
||||
|
||||
isNotAnyInfix :: [String] -> String -> Bool
|
||||
isNotAnyInfix xs t = foldr (\a b -> not (a `isInfixOf` t) && b) True xs
|
||||
|
||||
|
||||
-- | This file, when residing in @~\/.ghcup\/ghc\/\<ver\>\/@ signals that
|
||||
|
||||
@@ -31,7 +31,7 @@ import Control.Monad.IO.Class
|
||||
import Control.Monad.Reader
|
||||
import Data.Bifunctor
|
||||
import Data.ByteString ( ByteString )
|
||||
import Data.List ( nub )
|
||||
import Data.List ( nub, intercalate )
|
||||
import Data.Foldable
|
||||
import Data.String
|
||||
import Data.Text ( Text )
|
||||
@@ -55,6 +55,7 @@ import GHC.IO.Exception
|
||||
import qualified Data.ByteString as B
|
||||
import qualified Data.ByteString.Lazy as L
|
||||
import qualified Data.Strict.Maybe as S
|
||||
import qualified Data.List.Split as Split
|
||||
import qualified Data.Text as T
|
||||
import qualified Data.Text.Encoding as E
|
||||
import qualified Data.Text.Encoding.Error as E
|
||||
@@ -518,3 +519,19 @@ isNewLine w
|
||||
| w == _lf = True
|
||||
| w == _cr = True
|
||||
| otherwise = False
|
||||
|
||||
|
||||
-- | Split on a PVP suffix.
|
||||
--
|
||||
-- >>> splitOnPVP "-" "ghc-iserv-dyn-9.3.20210706" == ("ghc-iserv-dyn", "9.3.20210706")
|
||||
-- >>> splitOnPVP "-" "ghc-iserv-dyn" == ("ghc-iserv-dyn", "")
|
||||
splitOnPVP :: String -> String -> (String, String)
|
||||
splitOnPVP c s = case Split.splitOn c s of
|
||||
[] -> def
|
||||
[_] -> def
|
||||
xs
|
||||
| let l = last xs
|
||||
, (Right _) <- pvp (T.pack l) -> (intercalate c (init xs), l)
|
||||
| otherwise -> def
|
||||
where
|
||||
def = (s, "")
|
||||
|
||||
@@ -128,7 +128,10 @@
|
||||
<div>
|
||||
<p>
|
||||
If you are running Windows,<br/>run the following in a powershell session (as a non-admin user).
|
||||
<div class="command-button"><pre><span class='ghcup-command'>Set-ExecutionPolicy Bypass -Scope Process -Force;[System.Net.ServicePointManager]::SecurityProtocol = [System.Net.ServicePointManager]::SecurityProtocol -bor 3072;Invoke-Command -ScriptBlock ([ScriptBlock]::Create((Invoke-WebRequest https://www.haskell.org/ghcup/sh/bootstrap-haskell.ps1 -UseBasicParsing))) -ArgumentList $false</span></span></pre><button class="tooltip" onclick="copyToClipboardPowershell()"><img src="copy.svg" alt="" /><span class="tooltiptext">Copy to clipboard</span></button></div>
|
||||
<div class="command-button"><pre><span class='ghcup-command'>Set-ExecutionPolicy Bypass -Scope Process -Force;[System.Net.ServicePointManager]::SecurityProtocol = [System.Net.ServicePointManager]::SecurityProtocol -bor 3072;Invoke-Command -ScriptBlock ([ScriptBlock]::Create((Invoke-WebRequest https://www.haskell.org/ghcup/sh/bootstrap-haskell.ps1 -UseBasicParsing))) -ArgumentList $true</span></span></pre><button class="tooltip" onclick="copyToClipboardPowershell()"><img src="copy.svg" alt="" /><span class="tooltiptext">Copy to clipboard</span></button>
|
||||
</div>
|
||||
<p class="other-help">If you want to run a non-interactive installation, change <span class='code'>$true</span> to <span class='code'>$false</span> at the end of the script.</p>
|
||||
</div>
|
||||
</p>
|
||||
</div>
|
||||
|
||||
|
||||
Reference in New Issue
Block a user