Compare commits

..

18 Commits

Author SHA1 Message Date
5a34191b88 Fix listTools to always show currently installed GHCup 2021-07-27 22:33:35 +02:00
85003900d7 Improve HLS post-install formatting 2021-07-27 20:58:39 +02:00
0c666a6bbe Fix upgrade subcommand running appstate twice 2021-07-27 20:57:51 +02:00
e4e52ebf6b Bump to 0.1.16 2021-07-27 20:39:12 +02:00
4512468108 Also upload dist-newstyle/cache on failure 2021-07-27 10:39:55 +02:00
d3e3ebd63f Merge branch 'fix-ghcToolFiles' 2021-07-26 21:25:00 +02:00
ce616d3eb3 Improve bootstrap-haskell.ps1 2021-07-26 18:14:07 +02:00
5837e04e6e Cleanup 2021-07-26 18:13:57 +02:00
95ca79f3f8 Turn leftover files into logError 2021-07-26 18:13:41 +02:00
706fe1ffcc Don't do update checks for all commands 2021-07-26 18:13:20 +02:00
2774f026e8 Merge branch 'issue-150' 2021-07-26 17:44:37 +02:00
07604a2eb5 Merge branch 'issue-193' 2021-07-26 17:39:13 +02:00
1dc9ad7a57 Merge branch 'www-false' 2021-07-25 19:56:56 +02:00
cc51d7b454 Merge branch 'add-binutils-gold-for-alpine-pkgs' 2021-07-25 19:56:24 +02:00
c439693a8f Fix "display all supported installers" page 2021-07-25 19:10:02 +02:00
af8c097092 Add binutils gold for alpine pkgs 2021-07-25 19:06:22 +02:00
928f4a97de Fix ghcToolFiles for upcoming GHC build system changes
Also see: https://gitlab.haskell.org/ghc/ghc/-/issues/20074#note_363720
2021-07-10 21:43:37 +02:00
abbe51614d Improve uninstallation on windows wrt #150 2021-07-07 23:19:50 +02:00
10 changed files with 178 additions and 82 deletions

View File

@@ -104,6 +104,7 @@ variables:
expire_in: 2 week expire_in: 2 week
paths: paths:
- golden - golden
- dist-newstyle/cache/
when: on_failure when: on_failure
# .test_ghcup_scoop: # .test_ghcup_scoop:
@@ -202,6 +203,7 @@ variables:
expire_in: 2 week expire_in: 2 week
paths: paths:
- out - out
- dist-newstyle/cache/
only: only:
- tags - tags
variables: variables:

View File

@@ -126,7 +126,7 @@ validate dls _ = do
_ -> lift $ $(logWarn) [i|Linux Alpine missing for #{t} #{v'} #{arch'}|] _ -> lift $ $(logWarn) [i|Linux Alpine missing for #{t} #{v'} #{arch'}|]
checkUniqueTags tool = do checkUniqueTags tool = do
let allTags = join $ M.elems $ availableToolVersions dls tool let allTags = join $ fmap _viTags $ M.elems $ availableToolVersions dls tool
let nonUnique = let nonUnique =
fmap fst fmap fst
. filter (\(_, b) -> not b) . filter (\(_, b) -> not b)
@@ -164,7 +164,7 @@ validate dls _ = do
-- a tool must have at least one of each mandatory tags -- a tool must have at least one of each mandatory tags
checkMandatoryTags tool = do 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 forM_ [Latest, Recommended] $ \t -> case elem t allTags of
False -> do False -> do
lift $ $(logError) [i|Tag #{t} missing from #{tool}|] lift $ $(logError) [i|Tag #{t} missing from #{tool}|]
@@ -174,7 +174,7 @@ validate dls _ = do
-- all GHC versions must have a base tag -- all GHC versions must have a base tag
checkGHCHasBaseVersion = do checkGHCHasBaseVersion = do
let allTags = M.toList $ availableToolVersions dls GHC 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 False -> do
lift $ $(logError) [i|Base tag missing from GHC ver #{ver}|] lift $ $(logError) [i|Base tag missing from GHC ver #{ver}|]
addError addError

View File

@@ -1061,6 +1061,7 @@ tagCompleter tool add = listIOCompleter $ do
VRight ghcupInfo -> do VRight ghcupInfo -> do
let allTags = filter (\t -> t /= Old) let allTags = filter (\t -> t /= Old)
$ join $ join
$ fmap _viTags
$ M.elems $ M.elems
$ availableToolVersions (_ghcupDownloads ghcupInfo) tool $ availableToolVersions (_ghcupDownloads ghcupInfo) tool
pure $ nub $ (add ++) $ fmap tagToString allTags 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) 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|])) (threadDelay 5000000 >> runLogger ($(logWarn) [i|Killing cleanup thread (exceeded 5s timeout)... please remove leftover files in #{recycleDir} manually|]))
lookupEnv "GHCUP_SKIP_UPDATE_CHECK" >>= \case case optCommand of
Nothing -> runLogger $ flip runReaderT s' $ checkForUpdates Nuke -> pure ()
Just _ -> 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 -- TODO: always run for windows
(siletRunLogger $ flip runReaderT s' $ runE ensureGlobalTools) >>= \case (siletRunLogger $ flip runReaderT s' $ runE ensureGlobalTools) >>= \case
@@ -2017,22 +2027,25 @@ Make sure to clean up #{tmpdir} afterwards.|])
(UpgradeAt p) -> pure $ Just p (UpgradeAt p) -> pure $ Just p
UpgradeGHCupDir -> pure (Just (binDir </> "ghcup" <> exeExt)) UpgradeGHCupDir -> pure (Just (binDir </> "ghcup" <> exeExt))
runUpgrade (liftE $ upgradeGHCup target force') >>= \case runUpgrade (do
VRight v' -> do v' <- liftE $ upgradeGHCup target force'
GHCupInfo { _ghcupDownloads = dls } <- runAppState getGHCupInfo GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
let pretty_v = prettyVer v' pure (v', dls)
let vi = fromJust $ snd <$> getLatest dls GHCup ) >>= \case
runLogger $ $(logInfo) VRight (v', dls) -> do
[i|Successfully upgraded GHCup to version #{pretty_v}|] let pretty_v = prettyVer v'
forM_ (_viPostInstall vi) $ \msg -> let vi = fromJust $ snd <$> getLatest dls GHCup
runLogger $ $(logInfo) msg runLogger $ $(logInfo)
pure ExitSuccess [i|Successfully upgraded GHCup to version #{pretty_v}|]
VLeft (V NoUpdate) -> do forM_ (_viPostInstall vi) $ \msg ->
runLogger $ $(logWarn) [i|No GHCup update available|] runLogger $ $(logInfo) msg
pure ExitSuccess pure ExitSuccess
VLeft e -> do VLeft (V NoUpdate) -> do
runLogger $ $(logError) $ T.pack $ prettyShow e runLogger $ $(logWarn) [i|No GHCup update available|]
pure $ ExitFailure 11 pure ExitSuccess
VLeft e -> do
runLogger $ $(logError) $ T.pack $ prettyShow e
pure $ ExitFailure 11
ToolRequirements -> do ToolRequirements -> do
s' <- appState s' <- appState
@@ -2116,7 +2129,7 @@ Make sure to clean up #{tmpdir} afterwards.|])
runLogger $ $logInfo "Nuclear Annihilation complete!" runLogger $ $logInfo "Nuclear Annihilation complete!"
pure ExitSuccess pure ExitSuccess
| otherwise -> do | 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 forM_ leftOverFiles putStrLn
pure ExitSuccess pure ExitSuccess

View File

@@ -276,7 +276,7 @@ if ($CabalDir) {
while ($true) { while ($true) {
$defaultCabalDir = ('{0}\cabal' -f $GhcupBasePrefix) $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 $CabalDirPrompt = Read-Host
$CabDirEnv = ($defaultCabalDir,$CabalDirPrompt)[[bool]$CabalDirPrompt] $CabDirEnv = ($defaultCabalDir,$CabalDirPrompt)[[bool]$CabalDirPrompt]
@@ -383,7 +383,7 @@ if (!(Test-Path -Path ('{0}' -f $MsysDir))) {
while ($true) { while ($true) {
if ($GhcupMsys2) { if ($GhcupMsys2) {
$defaultMsys2Dir = $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 $MsysDirPrompt = Read-Host
$MsysDir = ($defaultMsys2Dir,$MsysDirPrompt)[[bool]$MsysDirPrompt] $MsysDir = ($defaultMsys2Dir,$MsysDirPrompt)[[bool]$MsysDirPrompt]
} else { } else {
@@ -412,11 +412,74 @@ if (!(Test-Path -Path ('{0}' -f $MsysDir))) {
} }
Print-Msg -msg 'Creating shortcuts...' 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") $DesktopDir = [Environment]::GetFolderPath("Desktop")
$GhcInstArgs = '-mingw64 -mintty -c "pacman --noconfirm -S --needed base-devel gettext autoconf make libtool automake python p7zip patch unzip"' $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 $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 ('{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) 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) Print-Msg -msg ('Adding {0}\bin to Users Path...' -f $GhcupDir)
Add-EnvPath -Path ('{0}\bin' -f ([System.IO.Path]::GetFullPath("$GhcupDir"))) -Container 'User' Add-EnvPath -Path ('{0}\bin' -f ([System.IO.Path]::GetFullPath("$GhcupDir"))) -Container 'User'

View File

@@ -96,6 +96,7 @@ toolRequirements:
Linux_Alpine: Linux_Alpine:
unknown_versioning: unknown_versioning:
distroPKGs: distroPKGs:
- binutils-gold
- curl - curl
- gcc - gcc
- g++ - g++
@@ -2075,7 +2076,10 @@ ghcupDownloads:
1.1.0: 1.1.0:
viTags: [] viTags: []
viChangeLog: https://github.com/haskell/haskell-language-server/blob/master/ChangeLog.md#110 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: viArch:
A_64: A_64:
Linux_UnknownLinux: Linux_UnknownLinux:
@@ -2097,7 +2101,7 @@ ghcupDownloads:
- Recommended - Recommended
- Latest - Latest
viChangeLog: https://github.com/haskell/haskell-language-server/blob/master/ChangeLog.md#120 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: viArch:
A_64: A_64:
Linux_UnknownLinux: Linux_UnknownLinux:

View File

@@ -1,6 +1,6 @@
cabal-version: 3.0 cabal-version: 3.0
name: ghcup name: ghcup
version: 0.1.15.2 version: 0.1.16
license: LGPL-3.0-only license: LGPL-3.0-only
license-file: LICENSE license-file: LICENSE
copyright: Julian Ospald 2020 copyright: Julian Ospald 2020

View File

@@ -965,9 +965,9 @@ data ListResult = ListResult
-- | Extract all available tool versions and their tags. -- | 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 availableToolVersions av tool = view
(at tool % non Map.empty % to (fmap _viTags)) (at tool % non Map.empty)
av av
@@ -1018,7 +1018,9 @@ listVersions lt' criteria = do
Stack -> do Stack -> do
slr <- strayStacks avTools sSet stacks slr <- strayStacks avTools sSet stacks
pure (sort (slr ++ lr)) pure (sort (slr ++ lr))
GHCup -> pure lr GHCup -> do
let cg = currentGHCup avTools
pure (sort (cg : lr))
Nothing -> do Nothing -> do
ghcvers <- go (Just GHC) cSet cabals hlsSet' hlses sSet stacks ghcvers <- go (Just GHC) cSet cabals hlsSet' hlses sSet stacks
cabalvers <- go (Just Cabal) 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 , MonadLogger m
, MonadIO m , MonadIO m
) )
=> Map.Map Version [Tag] => Map.Map Version VersionInfo
-> m [ListResult] -> m [ListResult]
strayGHCs avTools = do strayGHCs avTools = do
ghcs <- getInstalledGHCs ghcs <- getInstalledGHCs
@@ -1081,7 +1083,7 @@ listVersions lt' criteria = do
, MonadLogger m , MonadLogger m
, MonadIO m , MonadIO m
) )
=> Map.Map Version [Tag] => Map.Map Version VersionInfo
-> Maybe Version -> Maybe Version
-> [Either FilePath Version] -> [Either FilePath Version]
-> m [ListResult] -> m [ListResult]
@@ -1115,7 +1117,7 @@ listVersions lt' criteria = do
, MonadThrow m , MonadThrow m
, MonadLogger m , MonadLogger m
, MonadIO m) , MonadIO m)
=> Map.Map Version [Tag] => Map.Map Version VersionInfo
-> Maybe Version -> Maybe Version
-> [Either FilePath Version] -> [Either FilePath Version]
-> m [ListResult] -> m [ListResult]
@@ -1150,7 +1152,7 @@ listVersions lt' criteria = do
, MonadLogger m , MonadLogger m
, MonadIO m , MonadIO m
) )
=> Map.Map Version [Tag] => Map.Map Version VersionInfo
-> Maybe Version -> Maybe Version
-> [Either FilePath Version] -> [Either FilePath Version]
-> m [ListResult] -> m [ListResult]
@@ -1178,6 +1180,25 @@ listVersions lt' criteria = do
[i|Could not parse version of stray directory #{e}|] [i|Could not parse version of stray directory #{e}|]
pure Nothing 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 -- NOTE: this are not cross ones, because no bindists
toListResult :: ( MonadLogger m toListResult :: ( MonadLogger m
, MonadReader env m , MonadReader env m
@@ -1194,9 +1215,9 @@ listVersions lt' criteria = do
-> [Either FilePath Version] -> [Either FilePath Version]
-> Maybe Version -> Maybe Version
-> [Either FilePath Version] -> [Either FilePath Version]
-> (Version, [Tag]) -> (Version, VersionInfo)
-> m ListResult -> 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 case t of
GHC -> do GHC -> do
lNoBindist <- fmap (isLeft . veitherToEither) $ runE @'[NoDownload] $ getDownloadInfo GHC v lNoBindist <- fmap (isLeft . veitherToEither) $ runE @'[NoDownload] $ getDownloadInfo GHC v
@@ -1537,18 +1558,18 @@ rmGhcupDirs = do
where where
handleRm :: (MonadCatch m, MonadLogger m) => m () -> m () 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...|]) continuing regardless...|])
rmEnvFile :: (MonadLogger m, MonadReader env m, HasDirs env, MonadMask m, MonadIO m, MonadCatch m) => FilePath -> m () rmEnvFile :: (MonadLogger m, MonadReader env m, HasDirs env, MonadMask m, MonadIO m, MonadCatch m) => FilePath -> m ()
rmEnvFile enFilePath = do rmEnvFile enFilePath = do
$logInfo "Removing Ghcup Environment File" $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 :: (MonadLogger m, MonadReader env m, HasDirs env, MonadMask m, MonadIO m, MonadCatch m) => FilePath -> m ()
rmConfFile confFilePath = do rmConfFile confFilePath = do
$logInfo "removing Ghcup Config File" $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 :: (MonadLogger m, MonadReader env m, HasDirs env, MonadMask m, MonadIO m, MonadCatch m) => FilePath -> m ()
rmDir dir = rmDir dir =

View File

@@ -766,49 +766,22 @@ ghcToolFiles ver = do
whenM (fmap not $ liftIO $ doesDirectoryExist ghcdir) whenM (fmap not $ liftIO $ doesDirectoryExist ghcdir)
(throwE (NotInstalled GHC ver)) (throwE (NotInstalled GHC ver))
files <- liftIO $ listDirectory bindir files <- liftIO (listDirectory bindir >>= filterM (doesFileExist . (bindir </>)))
-- figure out the <ver> suffix, because this might not be `Version` for pure (getUniqueTools . groupToolFiles . fmap (dropSuffix exeExt) $ files)
-- alpha/rc releases, but x.y.a.somedate.
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 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 -- | This file, when residing in @~\/.ghcup\/ghc\/\<ver\>\/@ signals that

View File

@@ -31,7 +31,7 @@ import Control.Monad.IO.Class
import Control.Monad.Reader import Control.Monad.Reader
import Data.Bifunctor import Data.Bifunctor
import Data.ByteString ( ByteString ) import Data.ByteString ( ByteString )
import Data.List ( nub ) import Data.List ( nub, intercalate )
import Data.Foldable import Data.Foldable
import Data.String import Data.String
import Data.Text ( Text ) import Data.Text ( Text )
@@ -55,6 +55,7 @@ import GHC.IO.Exception
import qualified Data.ByteString as B import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as L import qualified Data.ByteString.Lazy as L
import qualified Data.Strict.Maybe as S import qualified Data.Strict.Maybe as S
import qualified Data.List.Split as Split
import qualified Data.Text as T import qualified Data.Text as T
import qualified Data.Text.Encoding as E import qualified Data.Text.Encoding as E
import qualified Data.Text.Encoding.Error as E import qualified Data.Text.Encoding.Error as E
@@ -518,3 +519,19 @@ isNewLine w
| w == _lf = True | w == _lf = True
| w == _cr = True | w == _cr = True
| otherwise = False | 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, "")

View File

@@ -128,7 +128,10 @@
<div> <div>
<p> <p>
If you are running Windows,<br/>run the following in a powershell session (as a non-admin user). 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> </p>
</div> </div>