parent
6623e4b1c8
commit
c149ee8d2b
@ -296,7 +296,7 @@ getDownloadInfo' :: ( MonadReader env m
|
|||||||
m
|
m
|
||||||
DownloadInfo
|
DownloadInfo
|
||||||
getDownloadInfo' t v = do
|
getDownloadInfo' t v = do
|
||||||
(PlatformRequest a p mv) <- lift getPlatformReq
|
pfreq@(PlatformRequest a p mv) <- lift getPlatformReq
|
||||||
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
||||||
|
|
||||||
let distro_preview f g =
|
let distro_preview f g =
|
||||||
@ -317,7 +317,7 @@ getDownloadInfo' t v = do
|
|||||||
without_distro = distro_preview (set _Linux UnknownLinux) (const Nothing)
|
without_distro = distro_preview (set _Linux UnknownLinux) (const Nothing)
|
||||||
|
|
||||||
maybe
|
maybe
|
||||||
(throwE NoDownload)
|
(throwE $ NoDownload v t (Just pfreq))
|
||||||
pure
|
pure
|
||||||
(case p of
|
(case p of
|
||||||
-- non-musl won't work on alpine
|
-- non-musl won't work on alpine
|
||||||
|
@ -206,12 +206,26 @@ instance HFErrorProject NoCompatiblePlatform where
|
|||||||
eDesc _ = "No compatible platform could be found"
|
eDesc _ = "No compatible platform could be found"
|
||||||
|
|
||||||
-- | Unable to find a download for the requested version/distro.
|
-- | Unable to find a download for the requested version/distro.
|
||||||
data NoDownload = NoDownload
|
data NoDownload = NoDownload GHCTargetVersion Tool (Maybe PlatformRequest)
|
||||||
|
| NoDownload' GlobalTool
|
||||||
deriving Show
|
deriving Show
|
||||||
|
|
||||||
instance Pretty NoDownload where
|
instance Pretty NoDownload where
|
||||||
pPrint NoDownload =
|
pPrint (NoDownload tver@(GHCTargetVersion mtarget vv) tool mpfreq)
|
||||||
text (eDesc (Proxy :: Proxy NoDownload))
|
| (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
|
instance HFErrorProject NoDownload where
|
||||||
eBase _ = 10
|
eBase _ = 10
|
||||||
|
@ -125,7 +125,7 @@ testGHCVer ver addMakeArgs = do
|
|||||||
|
|
||||||
dlInfo <-
|
dlInfo <-
|
||||||
preview (ix GHC % ix ver % viTestDL % _Just) dls
|
preview (ix GHC % ix ver % viTestDL % _Just) dls
|
||||||
?? NoDownload
|
?? NoDownload ver GHC Nothing
|
||||||
|
|
||||||
liftE $ testGHCBindist dlInfo ver addMakeArgs
|
liftE $ testGHCBindist dlInfo ver addMakeArgs
|
||||||
|
|
||||||
@ -260,7 +260,7 @@ fetchGHCSrc v mfp = do
|
|||||||
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
||||||
dlInfo <-
|
dlInfo <-
|
||||||
preview (ix GHC % ix v % viSourceDL % _Just) dls
|
preview (ix GHC % ix v % viSourceDL % _Just) dls
|
||||||
?? NoDownload
|
?? NoDownload v GHC Nothing
|
||||||
liftE $ downloadCached' dlInfo Nothing mfp
|
liftE $ downloadCached' dlInfo Nothing mfp
|
||||||
|
|
||||||
|
|
||||||
@ -818,7 +818,7 @@ compileGHC :: ( MonadMask m
|
|||||||
GHCTargetVersion
|
GHCTargetVersion
|
||||||
compileGHC targetGhc crossTarget ov bstrap jobs mbuildConfig patches aargs buildFlavour buildSystem installDir
|
compileGHC targetGhc crossTarget ov bstrap jobs mbuildConfig patches aargs buildFlavour buildSystem installDir
|
||||||
= do
|
= do
|
||||||
PlatformRequest { .. } <- lift getPlatformReq
|
pfreq@PlatformRequest { .. } <- lift getPlatformReq
|
||||||
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
||||||
|
|
||||||
(workdir, tmpUnpack, tver) <- case targetGhc of
|
(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
|
lift $ logDebug $ "Requested to compile: " <> prettyVer ver <> " with " <> either prettyVer T.pack bstrap
|
||||||
|
|
||||||
-- download source tarball
|
-- download source tarball
|
||||||
|
let tver = mkTVer ver
|
||||||
dlInfo <-
|
dlInfo <-
|
||||||
preview (ix GHC % ix (mkTVer ver) % viSourceDL % _Just) dls
|
preview (ix GHC % ix tver % viSourceDL % _Just) dls
|
||||||
?? NoDownload
|
?? NoDownload tver GHC (Just pfreq)
|
||||||
dl <- liftE $ downloadCached dlInfo Nothing
|
dl <- liftE $ downloadCached dlInfo Nothing
|
||||||
|
|
||||||
-- unpack
|
-- unpack
|
||||||
@ -1303,7 +1304,7 @@ compileGHC targetGhc crossTarget ov bstrap jobs mbuildConfig patches aargs build
|
|||||||
|
|
||||||
bghc = case bstrap of
|
bghc = case bstrap of
|
||||||
Right g -> g
|
Right g -> g
|
||||||
Left bver -> ("ghc-" <> (T.unpack . prettyVer $ bver) <> exeExt)
|
Left bver -> "ghc-" <> (T.unpack . prettyVer $ bver) <> exeExt
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
@ -354,7 +354,7 @@ compileHLS :: ( MonadMask m
|
|||||||
, NotInstalled
|
, NotInstalled
|
||||||
] m Version
|
] m Version
|
||||||
compileHLS targetHLS ghcs jobs ov installDir cabalProject cabalProjectLocal updateCabal patches cabalArgs = do
|
compileHLS targetHLS ghcs jobs ov installDir cabalProject cabalProjectLocal updateCabal patches cabalArgs = do
|
||||||
PlatformRequest { .. } <- lift getPlatformReq
|
pfreq@PlatformRequest { .. } <- lift getPlatformReq
|
||||||
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
||||||
Dirs { .. } <- lift getDirs
|
Dirs { .. } <- lift getDirs
|
||||||
|
|
||||||
@ -370,7 +370,7 @@ compileHLS targetHLS ghcs jobs ov installDir cabalProject cabalProjectLocal upda
|
|||||||
-- download source tarball
|
-- download source tarball
|
||||||
dlInfo <-
|
dlInfo <-
|
||||||
preview (ix HLS % ix (mkTVer tver) % viSourceDL % _Just) dls
|
preview (ix HLS % ix (mkTVer tver) % viSourceDL % _Just) dls
|
||||||
?? NoDownload
|
?? NoDownload (mkTVer tver) HLS (Just pfreq)
|
||||||
dl <- liftE $ downloadCached dlInfo Nothing
|
dl <- liftE $ downloadCached dlInfo Nothing
|
||||||
|
|
||||||
-- unpack
|
-- unpack
|
||||||
|
@ -132,6 +132,9 @@ data GlobalTool = ShimGen
|
|||||||
|
|
||||||
instance NFData GlobalTool
|
instance NFData GlobalTool
|
||||||
|
|
||||||
|
instance Pretty GlobalTool where
|
||||||
|
pPrint ShimGen = text "shimgen"
|
||||||
|
|
||||||
|
|
||||||
-- | All necessary information of a tool version, including
|
-- | All necessary information of a tool version, including
|
||||||
-- source download and per-architecture downloads.
|
-- source download and per-architecture downloads.
|
||||||
|
@ -1212,7 +1212,7 @@ ensureGlobalTools
|
|||||||
(GHCupInfo _ _ gTools) <- lift getGHCupInfo
|
(GHCupInfo _ _ gTools) <- lift getGHCupInfo
|
||||||
dirs <- lift getDirs
|
dirs <- lift getDirs
|
||||||
shimDownload <- liftE $ lE @_ @'[NoDownload]
|
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
|
let dl = downloadCached' shimDownload (Just "gs.exe") Nothing
|
||||||
void $ (\DigestError{} -> do
|
void $ (\DigestError{} -> do
|
||||||
lift $ logWarn "Digest doesn't match, redownloading gs.exe..."
|
lift $ logWarn "Digest doesn't match, redownloading gs.exe..."
|
||||||
|
Loading…
Reference in New Issue
Block a user