Print better error on 'ghcup <command> <tool>-<version>'

Wrt #180
This commit is contained in:
Julian Ospald 2023-07-20 21:41:22 +08:00
parent 6623e4b1c8
commit c149ee8d2b
No known key found for this signature in database
GPG Key ID: CCC85C0E40C06A8C
6 changed files with 32 additions and 14 deletions

View File

@ -296,7 +296,7 @@ getDownloadInfo' :: ( MonadReader env m
m
DownloadInfo
getDownloadInfo' t v = do
(PlatformRequest a p mv) <- lift getPlatformReq
pfreq@(PlatformRequest a p mv) <- lift getPlatformReq
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
let distro_preview f g =
@ -317,7 +317,7 @@ getDownloadInfo' t v = do
without_distro = distro_preview (set _Linux UnknownLinux) (const Nothing)
maybe
(throwE NoDownload)
(throwE $ NoDownload v t (Just pfreq))
pure
(case p of
-- non-musl won't work on alpine

View File

@ -206,12 +206,26 @@ instance HFErrorProject NoCompatiblePlatform where
eDesc _ = "No compatible platform could be found"
-- | Unable to find a download for the requested version/distro.
data NoDownload = NoDownload
data NoDownload = NoDownload GHCTargetVersion Tool (Maybe PlatformRequest)
| NoDownload' GlobalTool
deriving Show
instance Pretty NoDownload where
pPrint NoDownload =
text (eDesc (Proxy :: Proxy NoDownload))
pPrint (NoDownload tver@(GHCTargetVersion mtarget vv) tool mpfreq)
| (Just target) <- mtarget
, target `elem` (T.pack . prettyShow <$> enumFromTo (minBound :: Tool) (maxBound :: Tool))
= text $ "Unable to find a download for "
<> show tool
<> " version '"
<> T.unpack (tVerToText tver)
<> maybe "'\n" (\pfreq -> "' on detected platform " <> pfReqToString pfreq <> "\n") mpfreq
<> "Perhaps you meant: 'ghcup <command> "
<> T.unpack target
<> " "
<> T.unpack (prettyVer vv)
<> "'"
| otherwise = text $ "Unable to find a download for " <> T.unpack (tVerToText tver)
pPrint (NoDownload' globalTool) = text $ "Unable to find a download for " <> prettyShow globalTool
instance HFErrorProject NoDownload where
eBase _ = 10

View File

@ -125,7 +125,7 @@ testGHCVer ver addMakeArgs = do
dlInfo <-
preview (ix GHC % ix ver % viTestDL % _Just) dls
?? NoDownload
?? NoDownload ver GHC Nothing
liftE $ testGHCBindist dlInfo ver addMakeArgs
@ -260,7 +260,7 @@ fetchGHCSrc v mfp = do
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
dlInfo <-
preview (ix GHC % ix v % viSourceDL % _Just) dls
?? NoDownload
?? NoDownload v GHC Nothing
liftE $ downloadCached' dlInfo Nothing mfp
@ -818,7 +818,7 @@ compileGHC :: ( MonadMask m
GHCTargetVersion
compileGHC targetGhc crossTarget ov bstrap jobs mbuildConfig patches aargs buildFlavour buildSystem installDir
= do
PlatformRequest { .. } <- lift getPlatformReq
pfreq@PlatformRequest { .. } <- lift getPlatformReq
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
(workdir, tmpUnpack, tver) <- case targetGhc of
@ -827,9 +827,10 @@ compileGHC targetGhc crossTarget ov bstrap jobs mbuildConfig patches aargs build
lift $ logDebug $ "Requested to compile: " <> prettyVer ver <> " with " <> either prettyVer T.pack bstrap
-- download source tarball
let tver = mkTVer ver
dlInfo <-
preview (ix GHC % ix (mkTVer ver) % viSourceDL % _Just) dls
?? NoDownload
preview (ix GHC % ix tver % viSourceDL % _Just) dls
?? NoDownload tver GHC (Just pfreq)
dl <- liftE $ downloadCached dlInfo Nothing
-- unpack
@ -1303,7 +1304,7 @@ compileGHC targetGhc crossTarget ov bstrap jobs mbuildConfig patches aargs build
bghc = case bstrap of
Right g -> g
Left bver -> ("ghc-" <> (T.unpack . prettyVer $ bver) <> exeExt)
Left bver -> "ghc-" <> (T.unpack . prettyVer $ bver) <> exeExt

View File

@ -354,7 +354,7 @@ compileHLS :: ( MonadMask m
, NotInstalled
] m Version
compileHLS targetHLS ghcs jobs ov installDir cabalProject cabalProjectLocal updateCabal patches cabalArgs = do
PlatformRequest { .. } <- lift getPlatformReq
pfreq@PlatformRequest { .. } <- lift getPlatformReq
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
Dirs { .. } <- lift getDirs
@ -370,7 +370,7 @@ compileHLS targetHLS ghcs jobs ov installDir cabalProject cabalProjectLocal upda
-- download source tarball
dlInfo <-
preview (ix HLS % ix (mkTVer tver) % viSourceDL % _Just) dls
?? NoDownload
?? NoDownload (mkTVer tver) HLS (Just pfreq)
dl <- liftE $ downloadCached dlInfo Nothing
-- unpack

View File

@ -132,6 +132,9 @@ data GlobalTool = ShimGen
instance NFData GlobalTool
instance Pretty GlobalTool where
pPrint ShimGen = text "shimgen"
-- | All necessary information of a tool version, including
-- source download and per-architecture downloads.

View File

@ -1212,7 +1212,7 @@ ensureGlobalTools
(GHCupInfo _ _ gTools) <- lift getGHCupInfo
dirs <- lift getDirs
shimDownload <- liftE $ lE @_ @'[NoDownload]
$ maybe (Left NoDownload) Right $ Map.lookup ShimGen gTools
$ maybe (Left (NoDownload' ShimGen)) Right $ Map.lookup ShimGen gTools
let dl = downloadCached' shimDownload (Just "gs.exe") Nothing
void $ (\DigestError{} -> do
lift $ logWarn "Digest doesn't match, redownloading gs.exe..."