From c149ee8d2b03198d4bc6efeaf4b72964cec7c89e Mon Sep 17 00:00:00 2001 From: Julian Ospald Date: Thu, 20 Jul 2023 21:41:22 +0800 Subject: [PATCH] Print better error on 'ghcup -' Wrt #180 --- lib/GHCup/Download.hs | 4 ++-- lib/GHCup/Errors.hs | 20 +++++++++++++++++--- lib/GHCup/GHC.hs | 13 +++++++------ lib/GHCup/HLS.hs | 4 ++-- lib/GHCup/Types.hs | 3 +++ lib/GHCup/Utils.hs | 2 +- 6 files changed, 32 insertions(+), 14 deletions(-) diff --git a/lib/GHCup/Download.hs b/lib/GHCup/Download.hs index 9b5e549..418beb5 100644 --- a/lib/GHCup/Download.hs +++ b/lib/GHCup/Download.hs @@ -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 diff --git a/lib/GHCup/Errors.hs b/lib/GHCup/Errors.hs index 4fb29b2..72ba7d3 100644 --- a/lib/GHCup/Errors.hs +++ b/lib/GHCup/Errors.hs @@ -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 " + <> 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 diff --git a/lib/GHCup/GHC.hs b/lib/GHCup/GHC.hs index 2663370..4d0b4e2 100644 --- a/lib/GHCup/GHC.hs +++ b/lib/GHCup/GHC.hs @@ -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 diff --git a/lib/GHCup/HLS.hs b/lib/GHCup/HLS.hs index 744ba54..af4fcdf 100644 --- a/lib/GHCup/HLS.hs +++ b/lib/GHCup/HLS.hs @@ -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 diff --git a/lib/GHCup/Types.hs b/lib/GHCup/Types.hs index e71b2a5..b2c6beb 100644 --- a/lib/GHCup/Types.hs +++ b/lib/GHCup/Types.hs @@ -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. diff --git a/lib/GHCup/Utils.hs b/lib/GHCup/Utils.hs index 5f0e7f2..16259b9 100644 --- a/lib/GHCup/Utils.hs +++ b/lib/GHCup/Utils.hs @@ -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..."