Skip to content

Commit a05f272

Browse files
hasufellhasufell
committed
Merge remote-tracking branch 'origin/pr/844'
2 parents 7b1f591 + 07dfb1e commit a05f272

File tree

21 files changed

+209
-172
lines changed

21 files changed

+209
-172
lines changed

‎.github/scripts/cabal-cache.sh

+13
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,13 @@
1+
#!/usr/bin/env bash
2+
3+
case "$(uname -s)" in
4+
MSYS_*|MINGW*)
5+
ext=".exe"
6+
;;
7+
*)
8+
ext=""
9+
;;
10+
esac
11+
12+
echo "cabal-cache disabled (CABAL_CACHE_DISABLE set)"
13+

‎.github/scripts/common.sh

+6-2
Original file line numberDiff line numberDiff line change
@@ -15,7 +15,7 @@ sync_from() {
1515
cabal_store_path="$(dirname "$(cabal help user-config | tail -n 1 | xargs)")/store"
1616
fi
1717

18-
cabal-cache sync-from-archive \
18+
cabal-cache.sh sync-from-archive \
1919
--host-name-override=${S3_HOST} \
2020
--host-port-override=443 \
2121
--host-ssl-override=True \
@@ -29,7 +29,7 @@ sync_to() {
2929
cabal_store_path="$(dirname "$(cabal help user-config | tail -n 1 | xargs)")/store"
3030
fi
3131

32-
cabal-cache sync-to-archive \
32+
cabal-cache.sh sync-to-archive \
3333
--host-name-override=${S3_HOST} \
3434
--host-port-override=443 \
3535
--host-ssl-override=True \
@@ -115,6 +115,10 @@ download_cabal_cache() {
115115
mv "cabal-cache${exe}" "${dest}${exe}"
116116
chmod +x "${dest}${exe}"
117117
fi
118+
119+
# install shell wrapper
120+
cp "${CI_PROJECT_DIR}"/.github/scripts/cabal-cache.sh "$HOME"/.local/bin/
121+
chmod +x "$HOME"/.local/bin/cabal-cache.sh
118122
)
119123
}
120124

‎.github/workflows/release.yaml

+4
Original file line numberDiff line numberDiff line change
@@ -12,6 +12,10 @@ on:
1212
schedule:
1313
- cron: '0 2 * * *'
1414

15+
env:
16+
CABAL_CACHE_DISABLE: ${{ vars.CABAL_CACHE_DISABLE }}
17+
CABAL_CACHE_NONFATAL: yes
18+
1519
jobs:
1620
build-linux:
1721
name: Build linux binary

‎app/ghcup/BrickMain.hs

+11-11
Original file line numberDiff line numberDiff line change
@@ -156,10 +156,10 @@ ui dimAttrs BrickState{ appSettings = as@BrickSettings{}, ..}
156156
<+> padLeft (Pad 1) (minHSize 25 $ str "Tags")
157157
<+> padLeft (Pad 5) (str "Notes")
158158
renderList' bis@BrickInternalState{..} =
159-
let getMinLength = length . intercalate "," . fmap tagToString
160-
minLength = V.maximum $ V.map (getMinLength . lTag) clr
161-
in withDefAttr listAttr . drawListElements (renderItem minLength) True $ bis
162-
renderItem minTagSize _ b listResult@ListResult{lTag = lTag', ..} =
159+
let minTagSize = V.maximum $ V.map (length . intercalate "," . fmap tagToString . lTag) clr
160+
minVerSize = V.maximum $ V.map (\ListResult{..} -> T.length $ tVerToText (GHCTargetVersion lCross lVer)) clr
161+
in withDefAttr listAttr . drawListElements (renderItem minTagSize minVerSize) True $ bis
162+
renderItem minTagSize minVerSize _ b listResult@ListResult{lTag = lTag', ..} =
163163
let marks = if
164164
| lSet -> (withAttr (attrName "set") $ str "✔✔")
165165
| lInstalled -> (withAttr (attrName "installed") $ str "✓ ")
@@ -184,7 +184,7 @@ ui dimAttrs BrickState{ appSettings = as@BrickSettings{}, ..}
184184
( minHSize 6
185185
(printTool lTool)
186186
)
187-
<+> minHSize 15 (str ver)
187+
<+> minHSize minVerSize (str ver)
188188
<+> (let l = catMaybes . fmap printTag $ sort lTag'
189189
in padLeft (Pad 1) $ minHSize minTagSize $ if null l
190190
then emptyWidget
@@ -472,19 +472,19 @@ install' _ (_, ListResult {..}) = do
472472
dirs <- lift getDirs
473473
case lTool of
474474
GHC -> do
475-
let vi = getVersionInfo lVer GHC dls
476-
liftE $ installGHCBin lVer GHCupInternal False [] $> (vi, dirs, ce)
475+
let vi = getVersionInfo (GHCTargetVersion lCross lVer) GHC dls
476+
liftE $ installGHCBin (GHCTargetVersion lCross lVer) GHCupInternal False [] $> (vi, dirs, ce)
477477
Cabal -> do
478-
let vi = getVersionInfo lVer Cabal dls
478+
let vi = getVersionInfo (GHCTargetVersion lCross lVer) Cabal dls
479479
liftE $ installCabalBin lVer GHCupInternal False $> (vi, dirs, ce)
480480
GHCup -> do
481481
let vi = snd <$> getLatest dls GHCup
482482
liftE $ upgradeGHCup Nothing False False $> (vi, dirs, ce)
483483
HLS -> do
484-
let vi = getVersionInfo lVer HLS dls
484+
let vi = getVersionInfo (GHCTargetVersion lCross lVer) HLS dls
485485
liftE $ installHLSBin lVer GHCupInternal False $> (vi, dirs, ce)
486486
Stack -> do
487-
let vi = getVersionInfo lVer Stack dls
487+
let vi = getVersionInfo (GHCTargetVersion lCross lVer) Stack dls
488488
liftE $ installStackBin lVer GHCupInternal False $> (vi, dirs, ce)
489489
)
490490
>>= \case
@@ -565,7 +565,7 @@ del' _ (_, ListResult {..}) = do
565565
let run = runE @'[NotInstalled, UninstallFailed]
566566

567567
run (do
568-
let vi = getVersionInfo lVer lTool dls
568+
let vi = getVersionInfo (GHCTargetVersion lCross lVer) lTool dls
569569
case lTool of
570570
GHC -> liftE $ rmGHCVer (GHCTargetVersion lCross lVer) $> vi
571571
Cabal -> liftE $ rmCabalVer lVer $> vi

‎app/ghcup/GHCup/OptParse/Common.hs

+25-24
Original file line numberDiff line numberDiff line change
@@ -5,6 +5,7 @@
55
{-# LANGUAGE DuplicateRecordFields #-}
66
{-# LANGUAGE TypeApplications #-}
77
{-# LANGUAGE NumericUnderscores #-}
8+
{-# LANGUAGE ViewPatterns #-}
89

910
module GHCup.OptParse.Common where
1011

@@ -693,52 +694,52 @@ fromVersion' :: ( HasLog env
693694
] m (GHCTargetVersion, Maybe VersionInfo)
694695
fromVersion' SetRecommended tool = do
695696
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
696-
bimap mkTVer Just <$> getRecommended dls tool
697+
second Just <$> getRecommended dls tool
697698
?? TagNotFound Recommended tool
698699
fromVersion' (SetGHCVersion v) tool = do
699700
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
700-
let vi = getVersionInfo (_tvVersion v) tool dls
701+
let vi = getVersionInfo v tool dls
701702
case pvp $ prettyVer (_tvVersion v) of -- need to be strict here
702703
Left _ -> pure (v, vi)
703704
Right pvpIn ->
704-
lift (getLatestToolFor tool pvpIn dls) >>= \case
705-
Just (pvp_, vi') -> do
705+
lift (getLatestToolFor tool (_tvTarget v) pvpIn dls) >>= \case
706+
Just (pvp_, vi', mt) -> do
706707
v' <- lift $ pvpToVersion pvp_ ""
707708
when (v' /= _tvVersion v) $ lift $ logWarn ("Assuming you meant version " <> prettyVer v')
708-
pure (GHCTargetVersion (_tvTarget v) v', Just vi')
709+
pure (GHCTargetVersion mt v', Just vi')
709710
Nothing -> pure (v, vi)
710-
fromVersion' (SetToolVersion v) tool = do
711+
fromVersion' (SetToolVersion (mkTVer -> v)) tool = do
711712
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
712713
let vi = getVersionInfo v tool dls
713-
case pvp $ prettyVer v of -- need to be strict here
714-
Left _ -> pure (mkTVer v, vi)
714+
case pvp $ prettyVer (_tvVersion v) of -- need to be strict here
715+
Left _ -> pure (v, vi)
715716
Right pvpIn ->
716-
lift (getLatestToolFor tool pvpIn dls) >>= \case
717-
Just (pvp_, vi') -> do
717+
lift (getLatestToolFor tool (_tvTarget v) pvpIn dls) >>= \case
718+
Just (pvp_, vi', mt) -> do
718719
v' <- lift $ pvpToVersion pvp_ ""
719-
when (v' /= v) $ lift $ logWarn ("Assuming you meant version " <> prettyVer v')
720-
pure (GHCTargetVersion mempty v', Just vi')
721-
Nothing -> pure (mkTVer v, vi)
720+
when (v' /= _tvVersion v) $ lift $ logWarn ("Assuming you meant version " <> prettyVer v')
721+
pure (GHCTargetVersion mt v', Just vi')
722+
Nothing -> pure (v, vi)
722723
fromVersion' (SetToolTag Latest) tool = do
723724
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
724-
bimap mkTVer Just <$> getLatest dls tool ?? TagNotFound Latest tool
725+
bimap id Just <$> getLatest dls tool ?? TagNotFound Latest tool
725726
fromVersion' (SetToolDay day) tool = do
726727
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
727-
bimap mkTVer Just <$> case getByReleaseDay dls tool day of
728+
bimap id Just <$> case getByReleaseDay dls tool day of
728729
Left ad -> throwE $ DayNotFound day tool ad
729730
Right v -> pure v
730731
fromVersion' (SetToolTag LatestPrerelease) tool = do
731732
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
732-
bimap mkTVer Just <$> getLatestPrerelease dls tool ?? TagNotFound LatestPrerelease tool
733+
bimap id Just <$> getLatestPrerelease dls tool ?? TagNotFound LatestPrerelease tool
733734
fromVersion' (SetToolTag LatestNightly) tool = do
734735
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
735-
bimap mkTVer Just <$> getLatestNightly dls tool ?? TagNotFound LatestNightly tool
736+
bimap id Just <$> getLatestNightly dls tool ?? TagNotFound LatestNightly tool
736737
fromVersion' (SetToolTag Recommended) tool = do
737738
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
738-
bimap mkTVer Just <$> getRecommended dls tool ?? TagNotFound Recommended tool
739+
bimap id Just <$> getRecommended dls tool ?? TagNotFound Recommended tool
739740
fromVersion' (SetToolTag (Base pvp'')) GHC = do
740741
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
741-
bimap mkTVer Just <$> getLatestBaseVersion dls pvp'' ?? TagNotFound (Base pvp'') GHC
742+
bimap id Just <$> getLatestBaseVersion dls pvp'' ?? TagNotFound (Base pvp'') GHC
742743
fromVersion' SetNext tool = do
743744
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
744745
next <- case tool of
@@ -783,7 +784,7 @@ fromVersion' SetNext tool = do
783784
. sort
784785
$ stacks) ?? NoToolVersionSet tool
785786
GHCup -> fail "GHCup cannot be set"
786-
let vi = getVersionInfo (_tvVersion next) tool dls
787+
let vi = getVersionInfo next tool dls
787788
pure (next, vi)
788789
fromVersion' (SetToolTag t') tool =
789790
throwE $ TagNotFound t' tool
@@ -799,15 +800,15 @@ checkForUpdates :: ( MonadReader env m
799800
, MonadIO m
800801
, MonadFail m
801802
)
802-
=> m [(Tool, Version)]
803+
=> m [(Tool, GHCTargetVersion)]
803804
checkForUpdates = do
804805
GHCupInfo { _ghcupDownloads = dls } <- getGHCupInfo
805806
lInstalled <- listVersions Nothing [ListInstalled True] False False (Nothing, Nothing)
806-
let latestInstalled tool = (fmap lVer . lastMay . filter (\lr -> lTool lr == tool)) lInstalled
807+
let latestInstalled tool = (fmap (\lr -> GHCTargetVersion (lCross lr) (lVer lr)) . lastMay . filter (\lr -> lTool lr == tool)) lInstalled
807808

808-
ghcup <- forMM (getLatest dls GHCup) $ \(l, _) -> do
809+
ghcup <- forMM (getLatest dls GHCup) $ \(GHCTargetVersion _ l, _) -> do
809810
(Right ghcup_ver) <- pure $ version $ prettyPVP ghcUpVer
810-
if (l > ghcup_ver) then pure $ Just (GHCup, l) else pure Nothing
811+
if (l > ghcup_ver) then pure $ Just (GHCup, mkTVer l) else pure Nothing
811812

812813
otherTools <- forM [GHC, Cabal, HLS, Stack] $ \t ->
813814
forMM (getLatest dls t) $ \(l, _) -> do

‎app/ghcup/GHCup/OptParse/Compile.hs

+7-12
Original file line numberDiff line numberDiff line change
@@ -66,7 +66,7 @@ data CompileCommand = CompileGHC GHCCompileOptions
6666

6767

6868
data GHCCompileOptions = GHCCompileOptions
69-
{ targetGhc :: GHC.GHCVer Version
69+
{ targetGhc :: GHC.GHCVer
7070
, bootstrapGhc :: Either Version FilePath
7171
, jobs :: Maybe Int
7272
, buildConfig :: Maybe FilePath
@@ -511,7 +511,7 @@ compile compileCommand settings Dirs{..} runAppState runLogger = do
511511
case targetHLS of
512512
HLS.SourceDist targetVer -> do
513513
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
514-
let vi = getVersionInfo targetVer HLS dls
514+
let vi = getVersionInfo (mkTVer targetVer) HLS dls
515515
forM_ (_viPreCompile =<< vi) $ \msg -> do
516516
lift $ logInfo msg
517517
lift $ logInfo
@@ -531,7 +531,7 @@ compile compileCommand settings Dirs{..} runAppState runLogger = do
531531
patches
532532
cabalArgs
533533
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
534-
let vi = getVersionInfo targetVer HLS dls
534+
let vi = getVersionInfo (mkTVer targetVer) HLS dls
535535
when setCompile $ void $ liftE $
536536
setHLS targetVer SetHLSOnly Nothing
537537
pure (vi, targetVer)
@@ -555,26 +555,21 @@ compile compileCommand settings Dirs{..} runAppState runLogger = do
555555
VLeft e -> do
556556
runLogger $ logError $ T.pack $ prettyHFError e
557557
pure $ ExitFailure 9
558-
(CompileGHC GHCCompileOptions { hadrian = True, crossTarget = Just _ }) -> do
559-
runLogger $ logError "Hadrian cross compile support is not yet implemented!"
560-
pure $ ExitFailure 9
561558
(CompileGHC GHCCompileOptions {..}) ->
562559
runCompileGHC runAppState (do
563560
case targetGhc of
564561
GHC.SourceDist targetVer -> do
565562
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
566-
let vi = getVersionInfo targetVer GHC dls
563+
let vi = getVersionInfo (mkTVer targetVer) GHC dls
567564
forM_ (_viPreCompile =<< vi) $ \msg -> do
568565
lift $ logInfo msg
569566
lift $ logInfo
570567
"...waiting for 5 seconds, you can still abort..."
571568
liftIO $ threadDelay 5000000 -- for compilation, give the user a sec to intervene
572569
_ -> pure ()
573570
targetVer <- liftE $ compileGHC
574-
((\case
575-
GHC.SourceDist v -> GHC.SourceDist $ GHCTargetVersion crossTarget v
576-
GHC.GitDist g -> GHC.GitDist g
577-
GHC.RemoteDist r -> GHC.RemoteDist r) targetGhc)
571+
targetGhc
572+
crossTarget
578573
ovewrwiteVer
579574
bootstrapGhc
580575
jobs
@@ -585,7 +580,7 @@ compile compileCommand settings Dirs{..} runAppState runLogger = do
585580
hadrian
586581
(maybe GHCupInternal IsolateDir isolateDir)
587582
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
588-
let vi = getVersionInfo (_tvVersion targetVer) GHC dls
583+
let vi = getVersionInfo targetVer GHC dls
589584
when setCompile $ void $ liftE $
590585
setGHC targetVer SetGHCOnly Nothing
591586
pure (vi, targetVer)

‎app/ghcup/GHCup/OptParse/Install.hs

+2-2
Original file line numberDiff line numberDiff line change
@@ -324,7 +324,7 @@ install installCommand settings getAppState' runLogger = case installCommand of
324324
Nothing -> runInstGHC s' $ do
325325
(v, vi) <- liftE $ fromVersion instVer GHC
326326
liftE $ runBothE' (installGHCBin
327-
(_tvVersion v)
327+
v
328328
(maybe GHCupInternal IsolateDir isolateDir)
329329
forceInstall
330330
addConfArgs
@@ -336,7 +336,7 @@ install installCommand settings getAppState' runLogger = case installCommand of
336336
(v, vi) <- liftE $ fromVersion instVer GHC
337337
liftE $ runBothE' (installGHCBindist
338338
(DownloadInfo uri (Just $ RegexDir "ghc-.*") "" Nothing Nothing)
339-
(_tvVersion v)
339+
v
340340
(maybe GHCupInternal IsolateDir isolateDir)
341341
forceInstall
342342
addConfArgs

‎app/ghcup/GHCup/OptParse/Prefetch.hs

+1-1
Original file line numberDiff line numberDiff line change
@@ -195,7 +195,7 @@ prefetch prefetchCommand runAppState runLogger =
195195
forM_ pfCacheDir (liftIO . createDirRecursive')
196196
(v, _) <- liftE $ fromVersion mt GHC
197197
if pfGHCSrc
198-
then liftE $ fetchGHCSrc (_tvVersion v) pfCacheDir
198+
then liftE $ fetchGHCSrc v pfCacheDir
199199
else liftE $ fetchToolBindist (_tvVersion v) GHC pfCacheDir
200200
PrefetchCabal PrefetchOptions {pfCacheDir} mt -> do
201201
forM_ pfCacheDir (liftIO . createDirRecursive')

‎app/ghcup/GHCup/OptParse/Rm.hs

+4-4
Original file line numberDiff line numberDiff line change
@@ -170,7 +170,7 @@ rm rmCommand runAppState runLogger = case rmCommand of
170170
liftE $
171171
rmGHCVer ghcVer
172172
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
173-
pure (getVersionInfo (_tvVersion ghcVer) GHC dls)
173+
pure (getVersionInfo ghcVer GHC dls)
174174
)
175175
>>= \case
176176
VRight vi -> do
@@ -186,7 +186,7 @@ rm rmCommand runAppState runLogger = case rmCommand of
186186
liftE $
187187
rmCabalVer tv
188188
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
189-
pure (getVersionInfo tv Cabal dls)
189+
pure (getVersionInfo (mkTVer tv) Cabal dls)
190190
)
191191
>>= \case
192192
VRight vi -> do
@@ -201,7 +201,7 @@ rm rmCommand runAppState runLogger = case rmCommand of
201201
liftE $
202202
rmHLSVer tv
203203
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
204-
pure (getVersionInfo tv HLS dls)
204+
pure (getVersionInfo (mkTVer tv) HLS dls)
205205
)
206206
>>= \case
207207
VRight vi -> do
@@ -216,7 +216,7 @@ rm rmCommand runAppState runLogger = case rmCommand of
216216
liftE $
217217
rmStackVer tv
218218
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
219-
pure (getVersionInfo tv Stack dls)
219+
pure (getVersionInfo (mkTVer tv) Stack dls)
220220
)
221221
>>= \case
222222
VRight vi -> do

‎app/ghcup/GHCup/OptParse/Run.hs

+1-1
Original file line numberDiff line numberDiff line change
@@ -360,7 +360,7 @@ run RunOptions{..} runAppState leanAppstate runLogger = do
360360
Just v -> do
361361
isInstalled <- lift $ checkIfToolInstalled' GHC v
362362
unless isInstalled $ when (runInstTool' && isNothing (_tvTarget v)) $ void $ liftE $ installGHCBin
363-
(_tvVersion v)
363+
v
364364
GHCupInternal
365365
False
366366
[]

‎app/ghcup/GHCup/OptParse/Test.hs

+2-2
Original file line numberDiff line numberDiff line change
@@ -169,12 +169,12 @@ test testCommand settings getAppState' runLogger = case testCommand of
169169
(case testBindist of
170170
Nothing -> runTestGHC s' $ do
171171
(v, vi) <- liftE $ fromVersion testVer GHC
172-
liftE $ testGHCVer (_tvVersion v) addMakeArgs
172+
liftE $ testGHCVer v addMakeArgs
173173
pure vi
174174
Just uri -> do
175175
runTestGHC s'{ settings = settings {noVerify = True}} $ do
176176
(v, vi) <- liftE $ fromVersion testVer GHC
177-
liftE $ testGHCBindist (DownloadInfo uri (Just $ RegexDir ".*/.*") "" Nothing Nothing) (_tvVersion v) addMakeArgs
177+
liftE $ testGHCBindist (DownloadInfo uri (Just $ RegexDir ".*/.*") "" Nothing Nothing) v addMakeArgs
178178
pure vi
179179
)
180180
>>= \case

0 commit comments

Comments
 (0)