Compare commits

...

22 Commits

Author SHA1 Message Date
6d325a1804 Fix docker builds 2023-07-11 23:44:49 +08:00
a05f272b58 Merge remote-tracking branch 'origin/pr/844' 2023-07-11 23:30:51 +08:00
07dfb1e94b Fix tests 2023-07-08 00:07:29 +08:00
6ff07d3dbc Disable fking cabal-cache 2023-07-07 23:41:28 +08:00
0da5572164 Don't need --bignum option 2023-07-07 23:20:16 +08:00
422b99a222 Make cabal-cache non-fatal 2023-07-07 23:20:06 +08:00
055df584a4 Avoid duplicates in cross compilers showing up 2023-07-07 21:09:55 +08:00
9798e0f1d2 Fix brick min size for version column 2023-07-07 17:37:20 +08:00
a43fa7d63e More cross fixes to install bindist 2023-07-07 16:41:58 +08:00
4361ef7a72 Fix cross target being ignored 2023-07-07 00:39:31 +08:00
Sylvain Henry
3218aaa378 Allow cross-compilation with Hadrian 2023-07-07 00:38:50 +08:00
186a37cf3e Fix cross bindist installation 2023-07-07 00:38:50 +08:00
Sylvain Henry
7b1f591cc4 Fix Lint issues 2023-07-06 20:49:57 +08:00
0ecd244177 Update playground link 2023-07-06 20:43:14 +08:00
e14600ae75 Update ghver in bootstrap script 2023-07-02 18:56:18 +08:00
0884756139 Update metadata 2023-07-02 18:55:57 +08:00
4c539d62c1 Add create yaml script 2023-07-02 18:55:40 +08:00
f5b58d1db7 Update metadata submodule 2023-07-02 15:35:39 +08:00
18f6a74d08 Bump cabal in CI to 3.10.1.0 2023-07-02 12:34:04 +08:00
becb3436d0 Bump to 0.1.19.4 2023-07-02 12:32:11 +08:00
1f220cd488 Update metadata submodule 2023-06-29 20:14:41 +08:00
572ee06bbb Update ghcup version in bootstrap script 2023-06-29 20:12:10 +08:00
36 changed files with 310 additions and 198 deletions

13
.github/scripts/cabal-cache.sh vendored Normal file
View File

@@ -0,0 +1,13 @@
#!/usr/bin/env bash
case "$(uname -s)" in
MSYS_*|MINGW*)
ext=".exe"
;;
*)
ext=""
;;
esac
echo "cabal-cache disabled (CABAL_CACHE_DISABLE set)"

View File

@@ -15,7 +15,7 @@ sync_from() {
cabal_store_path="$(dirname "$(cabal help user-config | tail -n 1 | xargs)")/store" cabal_store_path="$(dirname "$(cabal help user-config | tail -n 1 | xargs)")/store"
fi fi
cabal-cache sync-from-archive \ cabal-cache.sh sync-from-archive \
--host-name-override=${S3_HOST} \ --host-name-override=${S3_HOST} \
--host-port-override=443 \ --host-port-override=443 \
--host-ssl-override=True \ --host-ssl-override=True \
@@ -29,7 +29,7 @@ sync_to() {
cabal_store_path="$(dirname "$(cabal help user-config | tail -n 1 | xargs)")/store" cabal_store_path="$(dirname "$(cabal help user-config | tail -n 1 | xargs)")/store"
fi fi
cabal-cache sync-to-archive \ cabal-cache.sh sync-to-archive \
--host-name-override=${S3_HOST} \ --host-name-override=${S3_HOST} \
--host-port-override=443 \ --host-port-override=443 \
--host-ssl-override=True \ --host-ssl-override=True \
@@ -115,6 +115,10 @@ download_cabal_cache() {
mv "cabal-cache${exe}" "${dest}${exe}" mv "cabal-cache${exe}" "${dest}${exe}"
chmod +x "${dest}${exe}" chmod +x "${dest}${exe}"
fi fi
# install shell wrapper
cp "${CI_PROJECT_DIR}"/.github/scripts/cabal-cache.sh "$HOME"/.local/bin/
chmod +x "$HOME"/.local/bin/cabal-cache.sh
) )
} }

View File

@@ -12,12 +12,16 @@ on:
schedule: schedule:
- cron: '0 2 * * *' - cron: '0 2 * * *'
env:
CABAL_CACHE_DISABLE: ${{ vars.CABAL_CACHE_DISABLE }}
CABAL_CACHE_NONFATAL: yes
jobs: jobs:
build-linux: build-linux:
name: Build linux binary name: Build linux binary
runs-on: ${{ matrix.os }} runs-on: ${{ matrix.os }}
env: env:
CABAL_VER: 3.8.1.0 CABAL_VER: 3.10.1.0
JSON_VERSION: "0.0.7" JSON_VERSION: "0.0.7"
AWS_SECRET_ACCESS_KEY: ${{ secrets.AWS_SECRET_ACCESS_KEY }} AWS_SECRET_ACCESS_KEY: ${{ secrets.AWS_SECRET_ACCESS_KEY }}
AWS_ACCESS_KEY_ID: ${{ secrets.AWS_ACCESS_KEY_ID }} AWS_ACCESS_KEY_ID: ${{ secrets.AWS_ACCESS_KEY_ID }}
@@ -81,7 +85,7 @@ jobs:
name: Build ARM binary name: Build ARM binary
runs-on: ${{ matrix.os }} runs-on: ${{ matrix.os }}
env: env:
CABAL_VER: 3.6.2.0 CABAL_VER: 3.10.1.0
JSON_VERSION: "0.0.7" JSON_VERSION: "0.0.7"
AWS_SECRET_ACCESS_KEY: ${{ secrets.AWS_SECRET_ACCESS_KEY }} AWS_SECRET_ACCESS_KEY: ${{ secrets.AWS_SECRET_ACCESS_KEY }}
AWS_ACCESS_KEY_ID: ${{ secrets.AWS_ACCESS_KEY_ID }} AWS_ACCESS_KEY_ID: ${{ secrets.AWS_ACCESS_KEY_ID }}
@@ -154,7 +158,7 @@ jobs:
name: Build binary (Mac/Win) name: Build binary (Mac/Win)
runs-on: ${{ matrix.os }} runs-on: ${{ matrix.os }}
env: env:
CABAL_VER: 3.8.1.0 CABAL_VER: 3.10.1.0
MACOSX_DEPLOYMENT_TARGET: 10.13 MACOSX_DEPLOYMENT_TARGET: 10.13
JSON_VERSION: "0.0.7" JSON_VERSION: "0.0.7"
AWS_SECRET_ACCESS_KEY: ${{ secrets.AWS_SECRET_ACCESS_KEY }} AWS_SECRET_ACCESS_KEY: ${{ secrets.AWS_SECRET_ACCESS_KEY }}
@@ -247,7 +251,7 @@ jobs:
needs: "build-linux" needs: "build-linux"
runs-on: ${{ matrix.os }} runs-on: ${{ matrix.os }}
env: env:
CABAL_VER: 3.8.1.0 CABAL_VER: 3.10.1.0
JSON_VERSION: "0.0.7" JSON_VERSION: "0.0.7"
strategy: strategy:
matrix: matrix:
@@ -325,7 +329,7 @@ jobs:
needs: "build-arm" needs: "build-arm"
runs-on: ${{ matrix.os }} runs-on: ${{ matrix.os }}
env: env:
CABAL_VER: 3.6.2.0 CABAL_VER: 3.10.1.0
JSON_VERSION: "0.0.7" JSON_VERSION: "0.0.7"
strategy: strategy:
matrix: matrix:
@@ -392,7 +396,7 @@ jobs:
needs: "build-macwin" needs: "build-macwin"
runs-on: ${{ matrix.os }} runs-on: ${{ matrix.os }}
env: env:
CABAL_VER: 3.8.1.0 CABAL_VER: 3.10.1.0
MACOSX_DEPLOYMENT_TARGET: 10.13 MACOSX_DEPLOYMENT_TARGET: 10.13
JSON_VERSION: "0.0.7" JSON_VERSION: "0.0.7"
strategy: strategy:

View File

@@ -1,5 +1,9 @@
# Revision history for ghcup # Revision history for ghcup
## 0.1.19.4 -- 2023-7-02
* fix missing TUI for aarch64 linux binaries
## 0.1.19.3 -- 2023-6-29 ## 0.1.19.3 -- 2023-6-29
* Implement support for nightlies, wrt [#824](https://github.com/haskell/ghcup-hs/issues/824) * Implement support for nightlies, wrt [#824](https://github.com/haskell/ghcup-hs/issues/824)

View File

@@ -156,10 +156,10 @@ ui dimAttrs BrickState{ appSettings = as@BrickSettings{}, ..}
<+> padLeft (Pad 1) (minHSize 25 $ str "Tags") <+> padLeft (Pad 1) (minHSize 25 $ str "Tags")
<+> padLeft (Pad 5) (str "Notes") <+> padLeft (Pad 5) (str "Notes")
renderList' bis@BrickInternalState{..} = renderList' bis@BrickInternalState{..} =
let getMinLength = length . intercalate "," . fmap tagToString let minTagSize = V.maximum $ V.map (length . intercalate "," . fmap tagToString . lTag) clr
minLength = V.maximum $ V.map (getMinLength . lTag) clr minVerSize = V.maximum $ V.map (\ListResult{..} -> T.length $ tVerToText (GHCTargetVersion lCross lVer)) clr
in withDefAttr listAttr . drawListElements (renderItem minLength) True $ bis in withDefAttr listAttr . drawListElements (renderItem minTagSize minVerSize) True $ bis
renderItem minTagSize _ b listResult@ListResult{lTag = lTag', ..} = renderItem minTagSize minVerSize _ b listResult@ListResult{lTag = lTag', ..} =
let marks = if let marks = if
| lSet -> (withAttr (attrName "set") $ str "✔✔") | lSet -> (withAttr (attrName "set") $ str "✔✔")
| lInstalled -> (withAttr (attrName "installed") $ str "") | lInstalled -> (withAttr (attrName "installed") $ str "")
@@ -184,7 +184,7 @@ ui dimAttrs BrickState{ appSettings = as@BrickSettings{}, ..}
( minHSize 6 ( minHSize 6
(printTool lTool) (printTool lTool)
) )
<+> minHSize 15 (str ver) <+> minHSize minVerSize (str ver)
<+> (let l = catMaybes . fmap printTag $ sort lTag' <+> (let l = catMaybes . fmap printTag $ sort lTag'
in padLeft (Pad 1) $ minHSize minTagSize $ if null l in padLeft (Pad 1) $ minHSize minTagSize $ if null l
then emptyWidget then emptyWidget
@@ -472,19 +472,19 @@ install' _ (_, ListResult {..}) = do
dirs <- lift getDirs dirs <- lift getDirs
case lTool of case lTool of
GHC -> do GHC -> do
let vi = getVersionInfo lVer GHC dls let vi = getVersionInfo (GHCTargetVersion lCross lVer) GHC dls
liftE $ installGHCBin lVer GHCupInternal False [] $> (vi, dirs, ce) liftE $ installGHCBin (GHCTargetVersion lCross lVer) GHCupInternal False [] $> (vi, dirs, ce)
Cabal -> do Cabal -> do
let vi = getVersionInfo lVer Cabal dls let vi = getVersionInfo (GHCTargetVersion lCross lVer) Cabal dls
liftE $ installCabalBin lVer GHCupInternal False $> (vi, dirs, ce) liftE $ installCabalBin lVer GHCupInternal False $> (vi, dirs, ce)
GHCup -> do GHCup -> do
let vi = snd <$> getLatest dls GHCup let vi = snd <$> getLatest dls GHCup
liftE $ upgradeGHCup Nothing False False $> (vi, dirs, ce) liftE $ upgradeGHCup Nothing False False $> (vi, dirs, ce)
HLS -> do HLS -> do
let vi = getVersionInfo lVer HLS dls let vi = getVersionInfo (GHCTargetVersion lCross lVer) HLS dls
liftE $ installHLSBin lVer GHCupInternal False $> (vi, dirs, ce) liftE $ installHLSBin lVer GHCupInternal False $> (vi, dirs, ce)
Stack -> do Stack -> do
let vi = getVersionInfo lVer Stack dls let vi = getVersionInfo (GHCTargetVersion lCross lVer) Stack dls
liftE $ installStackBin lVer GHCupInternal False $> (vi, dirs, ce) liftE $ installStackBin lVer GHCupInternal False $> (vi, dirs, ce)
) )
>>= \case >>= \case
@@ -565,7 +565,7 @@ del' _ (_, ListResult {..}) = do
let run = runE @'[NotInstalled, UninstallFailed] let run = runE @'[NotInstalled, UninstallFailed]
run (do run (do
let vi = getVersionInfo lVer lTool dls let vi = getVersionInfo (GHCTargetVersion lCross lVer) lTool dls
case lTool of case lTool of
GHC -> liftE $ rmGHCVer (GHCTargetVersion lCross lVer) $> vi GHC -> liftE $ rmGHCVer (GHCTargetVersion lCross lVer) $> vi
Cabal -> liftE $ rmCabalVer lVer $> vi Cabal -> liftE $ rmCabalVer lVer $> vi

View File

@@ -5,6 +5,7 @@
{-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeApplications #-}
{-# LANGUAGE NumericUnderscores #-} {-# LANGUAGE NumericUnderscores #-}
{-# LANGUAGE ViewPatterns #-}
module GHCup.OptParse.Common where module GHCup.OptParse.Common where
@@ -693,52 +694,52 @@ fromVersion' :: ( HasLog env
] m (GHCTargetVersion, Maybe VersionInfo) ] m (GHCTargetVersion, Maybe VersionInfo)
fromVersion' SetRecommended tool = do fromVersion' SetRecommended tool = do
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
bimap mkTVer Just <$> getRecommended dls tool second Just <$> getRecommended dls tool
?? TagNotFound Recommended tool ?? TagNotFound Recommended tool
fromVersion' (SetGHCVersion v) tool = do fromVersion' (SetGHCVersion v) tool = do
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
let vi = getVersionInfo (_tvVersion v) tool dls let vi = getVersionInfo v tool dls
case pvp $ prettyVer (_tvVersion v) of -- need to be strict here case pvp $ prettyVer (_tvVersion v) of -- need to be strict here
Left _ -> pure (v, vi) Left _ -> pure (v, vi)
Right pvpIn -> Right pvpIn ->
lift (getLatestToolFor tool pvpIn dls) >>= \case lift (getLatestToolFor tool (_tvTarget v) pvpIn dls) >>= \case
Just (pvp_, vi') -> do Just (pvp_, vi', mt) -> do
v' <- lift $ pvpToVersion pvp_ "" v' <- lift $ pvpToVersion pvp_ ""
when (v' /= _tvVersion v) $ lift $ logWarn ("Assuming you meant version " <> prettyVer v') when (v' /= _tvVersion v) $ lift $ logWarn ("Assuming you meant version " <> prettyVer v')
pure (GHCTargetVersion (_tvTarget v) v', Just vi') pure (GHCTargetVersion mt v', Just vi')
Nothing -> pure (v, vi) Nothing -> pure (v, vi)
fromVersion' (SetToolVersion v) tool = do fromVersion' (SetToolVersion (mkTVer -> v)) tool = do
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
let vi = getVersionInfo v tool dls let vi = getVersionInfo v tool dls
case pvp $ prettyVer v of -- need to be strict here case pvp $ prettyVer (_tvVersion v) of -- need to be strict here
Left _ -> pure (mkTVer v, vi) Left _ -> pure (v, vi)
Right pvpIn -> Right pvpIn ->
lift (getLatestToolFor tool pvpIn dls) >>= \case lift (getLatestToolFor tool (_tvTarget v) pvpIn dls) >>= \case
Just (pvp_, vi') -> do Just (pvp_, vi', mt) -> do
v' <- lift $ pvpToVersion pvp_ "" v' <- lift $ pvpToVersion pvp_ ""
when (v' /= v) $ lift $ logWarn ("Assuming you meant version " <> prettyVer v') when (v' /= _tvVersion v) $ lift $ logWarn ("Assuming you meant version " <> prettyVer v')
pure (GHCTargetVersion mempty v', Just vi') pure (GHCTargetVersion mt v', Just vi')
Nothing -> pure (mkTVer v, vi) Nothing -> pure (v, vi)
fromVersion' (SetToolTag Latest) tool = do fromVersion' (SetToolTag Latest) tool = do
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
bimap mkTVer Just <$> getLatest dls tool ?? TagNotFound Latest tool bimap id Just <$> getLatest dls tool ?? TagNotFound Latest tool
fromVersion' (SetToolDay day) tool = do fromVersion' (SetToolDay day) tool = do
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
bimap mkTVer Just <$> case getByReleaseDay dls tool day of bimap id Just <$> case getByReleaseDay dls tool day of
Left ad -> throwE $ DayNotFound day tool ad Left ad -> throwE $ DayNotFound day tool ad
Right v -> pure v Right v -> pure v
fromVersion' (SetToolTag LatestPrerelease) tool = do fromVersion' (SetToolTag LatestPrerelease) tool = do
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
bimap mkTVer Just <$> getLatestPrerelease dls tool ?? TagNotFound LatestPrerelease tool bimap id Just <$> getLatestPrerelease dls tool ?? TagNotFound LatestPrerelease tool
fromVersion' (SetToolTag LatestNightly) tool = do fromVersion' (SetToolTag LatestNightly) tool = do
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
bimap mkTVer Just <$> getLatestNightly dls tool ?? TagNotFound LatestNightly tool bimap id Just <$> getLatestNightly dls tool ?? TagNotFound LatestNightly tool
fromVersion' (SetToolTag Recommended) tool = do fromVersion' (SetToolTag Recommended) tool = do
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
bimap mkTVer Just <$> getRecommended dls tool ?? TagNotFound Recommended tool bimap id Just <$> getRecommended dls tool ?? TagNotFound Recommended tool
fromVersion' (SetToolTag (Base pvp'')) GHC = do fromVersion' (SetToolTag (Base pvp'')) GHC = do
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
bimap mkTVer Just <$> getLatestBaseVersion dls pvp'' ?? TagNotFound (Base pvp'') GHC bimap id Just <$> getLatestBaseVersion dls pvp'' ?? TagNotFound (Base pvp'') GHC
fromVersion' SetNext tool = do fromVersion' SetNext tool = do
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
next <- case tool of next <- case tool of
@@ -783,7 +784,7 @@ fromVersion' SetNext tool = do
. sort . sort
$ stacks) ?? NoToolVersionSet tool $ stacks) ?? NoToolVersionSet tool
GHCup -> fail "GHCup cannot be set" GHCup -> fail "GHCup cannot be set"
let vi = getVersionInfo (_tvVersion next) tool dls let vi = getVersionInfo next tool dls
pure (next, vi) pure (next, vi)
fromVersion' (SetToolTag t') tool = fromVersion' (SetToolTag t') tool =
throwE $ TagNotFound t' tool throwE $ TagNotFound t' tool
@@ -799,15 +800,15 @@ checkForUpdates :: ( MonadReader env m
, MonadIO m , MonadIO m
, MonadFail m , MonadFail m
) )
=> m [(Tool, Version)] => m [(Tool, GHCTargetVersion)]
checkForUpdates = do checkForUpdates = do
GHCupInfo { _ghcupDownloads = dls } <- getGHCupInfo GHCupInfo { _ghcupDownloads = dls } <- getGHCupInfo
lInstalled <- listVersions Nothing [ListInstalled True] False False (Nothing, Nothing) lInstalled <- listVersions Nothing [ListInstalled True] False False (Nothing, Nothing)
let latestInstalled tool = (fmap lVer . lastMay . filter (\lr -> lTool lr == tool)) lInstalled let latestInstalled tool = (fmap (\lr -> GHCTargetVersion (lCross lr) (lVer lr)) . lastMay . filter (\lr -> lTool lr == tool)) lInstalled
ghcup <- forMM (getLatest dls GHCup) $ \(l, _) -> do ghcup <- forMM (getLatest dls GHCup) $ \(GHCTargetVersion _ l, _) -> do
(Right ghcup_ver) <- pure $ version $ prettyPVP ghcUpVer (Right ghcup_ver) <- pure $ version $ prettyPVP ghcUpVer
if (l > ghcup_ver) then pure $ Just (GHCup, l) else pure Nothing if (l > ghcup_ver) then pure $ Just (GHCup, mkTVer l) else pure Nothing
otherTools <- forM [GHC, Cabal, HLS, Stack] $ \t -> otherTools <- forM [GHC, Cabal, HLS, Stack] $ \t ->
forMM (getLatest dls t) $ \(l, _) -> do forMM (getLatest dls t) $ \(l, _) -> do

View File

@@ -66,7 +66,7 @@ data CompileCommand = CompileGHC GHCCompileOptions
data GHCCompileOptions = GHCCompileOptions data GHCCompileOptions = GHCCompileOptions
{ targetGhc :: GHC.GHCVer Version { targetGhc :: GHC.GHCVer
, bootstrapGhc :: Either Version FilePath , bootstrapGhc :: Either Version FilePath
, jobs :: Maybe Int , jobs :: Maybe Int
, buildConfig :: Maybe FilePath , buildConfig :: Maybe FilePath
@@ -511,7 +511,7 @@ compile compileCommand settings Dirs{..} runAppState runLogger = do
case targetHLS of case targetHLS of
HLS.SourceDist targetVer -> do HLS.SourceDist targetVer -> do
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
let vi = getVersionInfo targetVer HLS dls let vi = getVersionInfo (mkTVer targetVer) HLS dls
forM_ (_viPreCompile =<< vi) $ \msg -> do forM_ (_viPreCompile =<< vi) $ \msg -> do
lift $ logInfo msg lift $ logInfo msg
lift $ logInfo lift $ logInfo
@@ -531,7 +531,7 @@ compile compileCommand settings Dirs{..} runAppState runLogger = do
patches patches
cabalArgs cabalArgs
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
let vi = getVersionInfo targetVer HLS dls let vi = getVersionInfo (mkTVer targetVer) HLS dls
when setCompile $ void $ liftE $ when setCompile $ void $ liftE $
setHLS targetVer SetHLSOnly Nothing setHLS targetVer SetHLSOnly Nothing
pure (vi, targetVer) pure (vi, targetVer)
@@ -555,15 +555,12 @@ compile compileCommand settings Dirs{..} runAppState runLogger = do
VLeft e -> do VLeft e -> do
runLogger $ logError $ T.pack $ prettyHFError e runLogger $ logError $ T.pack $ prettyHFError e
pure $ ExitFailure 9 pure $ ExitFailure 9
(CompileGHC GHCCompileOptions { hadrian = True, crossTarget = Just _ }) -> do
runLogger $ logError "Hadrian cross compile support is not yet implemented!"
pure $ ExitFailure 9
(CompileGHC GHCCompileOptions {..}) -> (CompileGHC GHCCompileOptions {..}) ->
runCompileGHC runAppState (do runCompileGHC runAppState (do
case targetGhc of case targetGhc of
GHC.SourceDist targetVer -> do GHC.SourceDist targetVer -> do
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
let vi = getVersionInfo targetVer GHC dls let vi = getVersionInfo (mkTVer targetVer) GHC dls
forM_ (_viPreCompile =<< vi) $ \msg -> do forM_ (_viPreCompile =<< vi) $ \msg -> do
lift $ logInfo msg lift $ logInfo msg
lift $ logInfo lift $ logInfo
@@ -571,10 +568,8 @@ compile compileCommand settings Dirs{..} runAppState runLogger = do
liftIO $ threadDelay 5000000 -- for compilation, give the user a sec to intervene liftIO $ threadDelay 5000000 -- for compilation, give the user a sec to intervene
_ -> pure () _ -> pure ()
targetVer <- liftE $ compileGHC targetVer <- liftE $ compileGHC
((\case targetGhc
GHC.SourceDist v -> GHC.SourceDist $ GHCTargetVersion crossTarget v crossTarget
GHC.GitDist g -> GHC.GitDist g
GHC.RemoteDist r -> GHC.RemoteDist r) targetGhc)
ovewrwiteVer ovewrwiteVer
bootstrapGhc bootstrapGhc
jobs jobs
@@ -585,7 +580,7 @@ compile compileCommand settings Dirs{..} runAppState runLogger = do
hadrian hadrian
(maybe GHCupInternal IsolateDir isolateDir) (maybe GHCupInternal IsolateDir isolateDir)
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
let vi = getVersionInfo (_tvVersion targetVer) GHC dls let vi = getVersionInfo targetVer GHC dls
when setCompile $ void $ liftE $ when setCompile $ void $ liftE $
setGHC targetVer SetGHCOnly Nothing setGHC targetVer SetGHCOnly Nothing
pure (vi, targetVer) pure (vi, targetVer)

View File

@@ -324,7 +324,7 @@ install installCommand settings getAppState' runLogger = case installCommand of
Nothing -> runInstGHC s' $ do Nothing -> runInstGHC s' $ do
(v, vi) <- liftE $ fromVersion instVer GHC (v, vi) <- liftE $ fromVersion instVer GHC
liftE $ runBothE' (installGHCBin liftE $ runBothE' (installGHCBin
(_tvVersion v) v
(maybe GHCupInternal IsolateDir isolateDir) (maybe GHCupInternal IsolateDir isolateDir)
forceInstall forceInstall
addConfArgs addConfArgs
@@ -336,7 +336,7 @@ install installCommand settings getAppState' runLogger = case installCommand of
(v, vi) <- liftE $ fromVersion instVer GHC (v, vi) <- liftE $ fromVersion instVer GHC
liftE $ runBothE' (installGHCBindist liftE $ runBothE' (installGHCBindist
(DownloadInfo uri (Just $ RegexDir "ghc-.*") "" Nothing Nothing) (DownloadInfo uri (Just $ RegexDir "ghc-.*") "" Nothing Nothing)
(_tvVersion v) v
(maybe GHCupInternal IsolateDir isolateDir) (maybe GHCupInternal IsolateDir isolateDir)
forceInstall forceInstall
addConfArgs addConfArgs

View File

@@ -195,7 +195,7 @@ prefetch prefetchCommand runAppState runLogger =
forM_ pfCacheDir (liftIO . createDirRecursive') forM_ pfCacheDir (liftIO . createDirRecursive')
(v, _) <- liftE $ fromVersion mt GHC (v, _) <- liftE $ fromVersion mt GHC
if pfGHCSrc if pfGHCSrc
then liftE $ fetchGHCSrc (_tvVersion v) pfCacheDir then liftE $ fetchGHCSrc v pfCacheDir
else liftE $ fetchToolBindist (_tvVersion v) GHC pfCacheDir else liftE $ fetchToolBindist (_tvVersion v) GHC pfCacheDir
PrefetchCabal PrefetchOptions {pfCacheDir} mt -> do PrefetchCabal PrefetchOptions {pfCacheDir} mt -> do
forM_ pfCacheDir (liftIO . createDirRecursive') forM_ pfCacheDir (liftIO . createDirRecursive')

View File

@@ -170,7 +170,7 @@ rm rmCommand runAppState runLogger = case rmCommand of
liftE $ liftE $
rmGHCVer ghcVer rmGHCVer ghcVer
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
pure (getVersionInfo (_tvVersion ghcVer) GHC dls) pure (getVersionInfo ghcVer GHC dls)
) )
>>= \case >>= \case
VRight vi -> do VRight vi -> do
@@ -186,7 +186,7 @@ rm rmCommand runAppState runLogger = case rmCommand of
liftE $ liftE $
rmCabalVer tv rmCabalVer tv
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
pure (getVersionInfo tv Cabal dls) pure (getVersionInfo (mkTVer tv) Cabal dls)
) )
>>= \case >>= \case
VRight vi -> do VRight vi -> do
@@ -201,7 +201,7 @@ rm rmCommand runAppState runLogger = case rmCommand of
liftE $ liftE $
rmHLSVer tv rmHLSVer tv
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
pure (getVersionInfo tv HLS dls) pure (getVersionInfo (mkTVer tv) HLS dls)
) )
>>= \case >>= \case
VRight vi -> do VRight vi -> do
@@ -216,7 +216,7 @@ rm rmCommand runAppState runLogger = case rmCommand of
liftE $ liftE $
rmStackVer tv rmStackVer tv
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
pure (getVersionInfo tv Stack dls) pure (getVersionInfo (mkTVer tv) Stack dls)
) )
>>= \case >>= \case
VRight vi -> do VRight vi -> do

View File

@@ -360,7 +360,7 @@ run RunOptions{..} runAppState leanAppstate runLogger = do
Just v -> do Just v -> do
isInstalled <- lift $ checkIfToolInstalled' GHC v isInstalled <- lift $ checkIfToolInstalled' GHC v
unless isInstalled $ when (runInstTool' && isNothing (_tvTarget v)) $ void $ liftE $ installGHCBin unless isInstalled $ when (runInstTool' && isNothing (_tvTarget v)) $ void $ liftE $ installGHCBin
(_tvVersion v) v
GHCupInternal GHCupInternal
False False
[] []

View File

@@ -169,12 +169,12 @@ test testCommand settings getAppState' runLogger = case testCommand of
(case testBindist of (case testBindist of
Nothing -> runTestGHC s' $ do Nothing -> runTestGHC s' $ do
(v, vi) <- liftE $ fromVersion testVer GHC (v, vi) <- liftE $ fromVersion testVer GHC
liftE $ testGHCVer (_tvVersion v) addMakeArgs liftE $ testGHCVer v addMakeArgs
pure vi pure vi
Just uri -> do Just uri -> do
runTestGHC s'{ settings = settings {noVerify = True}} $ do runTestGHC s'{ settings = settings {noVerify = True}} $ do
(v, vi) <- liftE $ fromVersion testVer GHC (v, vi) <- liftE $ fromVersion testVer GHC
liftE $ testGHCBindist (DownloadInfo uri (Just $ RegexDir ".*/.*") "" Nothing Nothing) (_tvVersion v) addMakeArgs liftE $ testGHCBindist (DownloadInfo uri (Just $ RegexDir ".*/.*") "" Nothing Nothing) v addMakeArgs
pure vi pure vi
) )
>>= \case >>= \case

View File

@@ -249,7 +249,7 @@ Report bugs at <https://github.com/haskell/ghcup-hs/issues>|]
case t of case t of
GHCup -> runLogger $ GHCup -> runLogger $
logWarn ("New GHCup version available: " logWarn ("New GHCup version available: "
<> prettyVer l <> tVerToText l
<> ". To upgrade, run 'ghcup upgrade'") <> ". To upgrade, run 'ghcup upgrade'")
_ -> runLogger $ _ -> runLogger $
logWarn ("New " logWarn ("New "
@@ -258,7 +258,7 @@ Report bugs at <https://github.com/haskell/ghcup-hs/issues>|]
<> "If you want to install this latest version, run 'ghcup install " <> "If you want to install this latest version, run 'ghcup install "
<> T.pack (prettyShow t) <> T.pack (prettyShow t)
<> " " <> " "
<> prettyVer l <> tVerToText l
<> "'") <> "'")
Just _ -> pure () Just _ -> pure ()
@@ -332,7 +332,7 @@ Report bugs at <https://github.com/haskell/ghcup-hs/issues>|]
, MonadCatch m , MonadCatch m
) )
=> Command => Command
-> (Tool, Version) -> (Tool, GHCTargetVersion)
-> Excepts -> Excepts
'[ TagNotFound '[ TagNotFound
, DayNotFound , DayNotFound
@@ -368,7 +368,7 @@ Report bugs at <https://github.com/haskell/ghcup-hs/issues>|]
) )
=> Tool => Tool
-> Maybe ToolVersion -> Maybe ToolVersion
-> Version -> GHCTargetVersion
-> Excepts -> Excepts
'[ TagNotFound '[ TagNotFound
, DayNotFound , DayNotFound
@@ -377,4 +377,4 @@ Report bugs at <https://github.com/haskell/ghcup-hs/issues>|]
] m Bool ] m Bool
cmp' tool instVer ver = do cmp' tool instVer ver = do
(v, _) <- liftE $ fromVersion instVer tool (v, _) <- liftE $ fromVersion instVer tool
pure (v == mkTVer ver) pure (v == ver)

View File

@@ -37,8 +37,8 @@ RUN apk add --no-cache \
xz-dev \ xz-dev \
ncurses-static ncurses-static
ARG GHCUP_VERSION=0.1.18.0 ARG GHCUP_VERSION=0.1.19.4
ARG GPG_KEY=7784930957807690A66EBDBE3786C5262ECB4A3F ARG GPG_KEY=7D1E8AFD1D4A16D71FADA2F2CCC85C0E40C06A8C
# install ghcup # install ghcup
RUN gpg --batch --keyserver keys.openpgp.org --recv-keys $GPG_KEY && \ RUN gpg --batch --keyserver keys.openpgp.org --recv-keys $GPG_KEY && \

View File

@@ -37,8 +37,9 @@ RUN apk add --no-cache \
xz-dev \ xz-dev \
ncurses-static ncurses-static
ARG GHCUP_VERSION=0.1.18.0 ARG GHCUP_VERSION=0.1.19.4
ARG GPG_KEY=7784930957807690A66EBDBE3786C5262ECB4A3F ARG GPG_KEY=7D1E8AFD1D4A16D71FADA2F2CCC85C0E40C06A8C
# install ghcup # install ghcup
RUN gpg --batch --keyserver keys.openpgp.org --recv-keys $GPG_KEY && \ RUN gpg --batch --keyserver keys.openpgp.org --recv-keys $GPG_KEY && \

View File

@@ -29,8 +29,8 @@ RUN apt-get update && \
RUN update_opt.sh 11 1 RUN update_opt.sh 11 1
ARG GHCUP_VERSION=0.1.17.8 ARG GHCUP_VERSION=0.1.19.4
ARG GPG_KEY=7784930957807690A66EBDBE3786C5262ECB4A3F ARG GPG_KEY=7D1E8AFD1D4A16D71FADA2F2CCC85C0E40C06A8C
# install ghcup # install ghcup
RUN gpg --batch --keyserver keys.openpgp.org --recv-keys $GPG_KEY && \ RUN gpg --batch --keyserver keys.openpgp.org --recv-keys $GPG_KEY && \

View File

@@ -29,8 +29,8 @@ RUN apt-get update && \
RUN update_opt.sh 9 1 RUN update_opt.sh 9 1
ARG GHCUP_VERSION=0.1.17.8 ARG GHCUP_VERSION=0.1.19.4
ARG GPG_KEY=7784930957807690A66EBDBE3786C5262ECB4A3F ARG GPG_KEY=7D1E8AFD1D4A16D71FADA2F2CCC85C0E40C06A8C
# install ghcup # install ghcup
RUN gpg --batch --keyserver keys.openpgp.org --recv-keys $GPG_KEY && \ RUN gpg --batch --keyserver keys.openpgp.org --recv-keys $GPG_KEY && \

View File

@@ -29,8 +29,8 @@ RUN apt-get update && \
RUN update_opt.sh 11 1 RUN update_opt.sh 11 1
ARG GHCUP_VERSION=0.1.18.0 ARG GHCUP_VERSION=0.1.19.4
ARG GPG_KEY=7784930957807690A66EBDBE3786C5262ECB4A3F ARG GPG_KEY=7D1E8AFD1D4A16D71FADA2F2CCC85C0E40C06A8C
# install ghcup # install ghcup
RUN gpg --batch --keyserver keys.openpgp.org --recv-keys $GPG_KEY && \ RUN gpg --batch --keyserver keys.openpgp.org --recv-keys $GPG_KEY && \

View File

@@ -29,8 +29,8 @@ RUN apt-get update && \
RUN update_opt.sh 9 1 RUN update_opt.sh 9 1
ARG GHCUP_VERSION=0.1.18.0 ARG GHCUP_VERSION=0.1.19.4
ARG GPG_KEY=7784930957807690A66EBDBE3786C5262ECB4A3F ARG GPG_KEY=7D1E8AFD1D4A16D71FADA2F2CCC85C0E40C06A8C
# install ghcup # install ghcup
RUN gpg --batch --keyserver keys.openpgp.org --recv-keys $GPG_KEY && \ RUN gpg --batch --keyserver keys.openpgp.org --recv-keys $GPG_KEY && \

View File

@@ -328,7 +328,7 @@ see the [Cabal user guide](https://cabal.readthedocs.io/en/stable/getting-starte
<a href="https://hackage.haskell.org/" class="btn btn-primary" role="button">Discover Haskell packages</a> <a href="https://hackage.haskell.org/" class="btn btn-primary" role="button">Discover Haskell packages</a>
<a href="https://hackage.haskell.org/package/base" class="btn btn-primary" role="button">The standard library</a> <a href="https://hackage.haskell.org/package/base" class="btn btn-primary" role="button">The standard library</a>
<a href="https://haskell-language-server.readthedocs.io/en/stable/installation.html" class="btn btn-primary" role="button">Editor setup with HLS</a> <a href="https://haskell-language-server.readthedocs.io/en/stable/installation.html" class="btn btn-primary" role="button">Editor setup with HLS</a>
<a href="https://play-haskell.tomsmeding.com/play" class="btn btn-primary" role="button">Online playground</a> <a href="https://play.haskell.org/" class="btn btn-primary" role="button">Online playground</a>
</div> </div>
## How to learn Haskell proper ## How to learn Haskell proper

View File

@@ -1,6 +1,6 @@
cabal-version: 2.4 cabal-version: 2.4
name: ghcup name: ghcup
version: 0.1.19.3 version: 0.1.19.4
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

@@ -303,7 +303,7 @@ upgradeGHCup mtarget force' fatal = do
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
lift $ logInfo "Upgrading GHCup..." lift $ logInfo "Upgrading GHCup..."
let latestVer = fst (fromJust (getLatest dls GHCup)) let latestVer = _tvVersion $ fst (fromJust (getLatest dls GHCup))
(Just ghcupPVPVer) <- pure $ pvpToVersion ghcUpVer "" (Just ghcupPVPVer) <- pure $ pvpToVersion ghcUpVer ""
when (not force' && (latestVer <= ghcupPVPVer)) $ throwE NoUpdate when (not force' && (latestVer <= ghcupPVPVer)) $ throwE NoUpdate
dli <- liftE $ getDownloadInfo GHCup latestVer dli <- liftE $ getDownloadInfo GHCup latestVer
@@ -492,7 +492,7 @@ rmOldGHC :: ( MonadReader env m
=> Excepts '[NotInstalled, UninstallFailed] m () => Excepts '[NotInstalled, UninstallFailed] m ()
rmOldGHC = do rmOldGHC = do
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
let oldGHCs = mkTVer <$> toListOf (ix GHC % getTagged Old % to fst) dls let oldGHCs = toListOf (ix GHC % getTagged Old % to fst) dls
ghcs <- lift $ fmap rights getInstalledGHCs ghcs <- lift $ fmap rights getInstalledGHCs
forM_ ghcs $ \ghc -> when (ghc `elem` oldGHCs) $ rmGHCVer ghc forM_ ghcs $ \ghc -> when (ghc `elem` oldGHCs) $ rmGHCVer ghc

View File

@@ -38,6 +38,7 @@ import Control.Monad.Trans.Resource
hiding ( throwM ) hiding ( throwM )
import Data.Either import Data.Either
import Data.List import Data.List
import Data.Ord
import Data.Maybe import Data.Maybe
import Data.Versions hiding ( patch ) import Data.Versions hiding ( patch )
import Haskus.Utils.Variant.Excepts import Haskus.Utils.Variant.Excepts
@@ -280,6 +281,6 @@ rmCabalVer ver = do
when (Just ver == cSet) $ do when (Just ver == cSet) $ do
cVers <- lift $ fmap rights getInstalledCabals cVers <- lift $ fmap rights getInstalledCabals
case headMay . reverse . sort $ cVers of case headMay . sortBy (comparing Down) $ cVers of
Just latestver -> setCabal latestver Just latestver -> setCabal latestver
Nothing -> lift $ rmLink (binDir </> "cabal" <> exeExt) Nothing -> lift $ rmLink (binDir </> "cabal" <> exeExt)

View File

@@ -271,7 +271,6 @@ getBase uri = do
pure f pure f
getDownloadInfo :: ( MonadReader env m getDownloadInfo :: ( MonadReader env m
, HasPlatformReq env , HasPlatformReq env
, HasGHCupInfo env , HasGHCupInfo env
@@ -283,7 +282,20 @@ getDownloadInfo :: ( MonadReader env m
'[NoDownload] '[NoDownload]
m m
DownloadInfo DownloadInfo
getDownloadInfo t v = do getDownloadInfo t v = getDownloadInfo' t (mkTVer v)
getDownloadInfo' :: ( MonadReader env m
, HasPlatformReq env
, HasGHCupInfo env
)
=> Tool
-> GHCTargetVersion
-- ^ tool version
-> Excepts
'[NoDownload]
m
DownloadInfo
getDownloadInfo' t v = do
(PlatformRequest a p mv) <- lift getPlatformReq (PlatformRequest a p mv) <- lift getPlatformReq
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo

View File

@@ -80,9 +80,9 @@ import qualified Data.Text.Encoding as E
import qualified Text.Megaparsec as MP import qualified Text.Megaparsec as MP
data GHCVer v = SourceDist v data GHCVer = SourceDist Version
| GitDist GitBranch | GitDist GitBranch
| RemoteDist URI | RemoteDist URI
@@ -105,7 +105,7 @@ testGHCVer :: ( MonadFail m
, MonadIO m , MonadIO m
, MonadUnliftIO m , MonadUnliftIO m
) )
=> Version => GHCTargetVersion
-> [T.Text] -> [T.Text]
-> Excepts -> Excepts
'[ DigestError '[ DigestError
@@ -145,7 +145,7 @@ testGHCBindist :: ( MonadFail m
, MonadUnliftIO m , MonadUnliftIO m
) )
=> DownloadInfo => DownloadInfo
-> Version -> GHCTargetVersion
-> [T.Text] -> [T.Text]
-> Excepts -> Excepts
'[ DigestError '[ DigestError
@@ -182,7 +182,7 @@ testPackedGHC :: ( MonadMask m
) )
=> FilePath -- ^ Path to the packed GHC bindist => FilePath -- ^ Path to the packed GHC bindist
-> Maybe TarDir -- ^ Subdir of the archive -> Maybe TarDir -- ^ Subdir of the archive
-> Version -- ^ The GHC version -> GHCTargetVersion -- ^ The GHC version
-> [T.Text] -- ^ additional make args -> [T.Text] -- ^ additional make args
-> Excepts -> Excepts
'[ ArchiveResult, UnknownArchive, TarDirDoesNotExist, TestFailed ] m () '[ ArchiveResult, UnknownArchive, TarDirDoesNotExist, TestFailed ] m ()
@@ -208,19 +208,21 @@ testUnpackedGHC :: ( MonadReader env m
, MonadIO m , MonadIO m
) )
=> GHCupPath -- ^ Path to the unpacked GHC bindist (where the make file resides) => GHCupPath -- ^ Path to the unpacked GHC bindist (where the make file resides)
-> Version -- ^ The GHC version -> GHCTargetVersion -- ^ The GHC version
-> [T.Text] -- ^ additional configure args for bindist -> [T.Text] -- ^ additional configure args for bindist
-> Excepts '[ProcessError] m () -> Excepts '[ProcessError] m ()
testUnpackedGHC path ver addMakeArgs = do testUnpackedGHC path tver addMakeArgs = do
lift $ logInfo $ "Testing GHC version " <> prettyVer ver <> "!" lift $ logInfo $ "Testing GHC version " <> tVerToText tver <> "!"
ghcDir <- lift $ ghcupGHCDir (mkTVer ver) ghcDir <- lift $ ghcupGHCDir tver
let ghcBinDir = fromGHCupPath ghcDir </> "bin" let ghcBinDir = fromGHCupPath ghcDir </> "bin"
env <- liftIO $ addToPath ghcBinDir False env <- liftIO $ addToPath ghcBinDir False
lEM $ make' (fmap T.unpack addMakeArgs) lEM $ make' (fmap T.unpack addMakeArgs)
(Just $ fromGHCupPath path) (Just $ fromGHCupPath path)
"ghc-test" "ghc-test"
(Just $ ("STAGE1_GHC", "ghc-" <> T.unpack (prettyVer ver)) : env) (Just $ ("STAGE1_GHC", maybe "" (T.unpack . (<> "-")) (_tvTarget tver)
<> "ghc-"
<> T.unpack (prettyVer $ _tvVersion tver)) : env)
pure () pure ()
@@ -243,7 +245,7 @@ fetchGHCSrc :: ( MonadFail m
, MonadIO m , MonadIO m
, MonadUnliftIO m , MonadUnliftIO m
) )
=> Version => GHCTargetVersion
-> Maybe FilePath -> Maybe FilePath
-> Excepts -> Excepts
'[ DigestError '[ DigestError
@@ -283,7 +285,7 @@ installGHCBindist :: ( MonadFail m
, MonadUnliftIO m , MonadUnliftIO m
) )
=> DownloadInfo -- ^ where/how to download => DownloadInfo -- ^ where/how to download
-> Version -- ^ the version to install -> GHCTargetVersion -- ^ the version to install
-> InstallDir -> InstallDir
-> Bool -- ^ Force install -> Bool -- ^ Force install
-> [T.Text] -- ^ additional configure args for bindist -> [T.Text] -- ^ additional configure args for bindist
@@ -306,10 +308,8 @@ installGHCBindist :: ( MonadFail m
] ]
m m
() ()
installGHCBindist dlinfo ver installDir forceInstall addConfArgs = do installGHCBindist dlinfo tver installDir forceInstall addConfArgs = do
let tver = mkTVer ver lift $ logDebug $ "Requested to install GHC with " <> tVerToText tver
lift $ logDebug $ "Requested to install GHC with " <> prettyVer ver
regularGHCInstalled <- lift $ ghcInstalled tver regularGHCInstalled <- lift $ ghcInstalled tver
@@ -317,7 +317,7 @@ installGHCBindist dlinfo ver installDir forceInstall addConfArgs = do
| not forceInstall | not forceInstall
, regularGHCInstalled , regularGHCInstalled
, GHCupInternal <- installDir -> do , GHCupInternal <- installDir -> do
throwE $ AlreadyInstalled GHC ver throwE $ AlreadyInstalled GHC (_tvVersion tver)
| forceInstall | forceInstall
, regularGHCInstalled , regularGHCInstalled
@@ -336,12 +336,12 @@ installGHCBindist dlinfo ver installDir forceInstall addConfArgs = do
case installDir of case installDir of
IsolateDir isoDir -> do -- isolated install IsolateDir isoDir -> do -- isolated install
lift $ logInfo $ "isolated installing GHC to " <> T.pack isoDir lift $ logInfo $ "isolated installing GHC to " <> T.pack isoDir
liftE $ installPackedGHC dl (view dlSubdir dlinfo) (IsolateDirResolved isoDir) ver forceInstall addConfArgs liftE $ installPackedGHC dl (view dlSubdir dlinfo) (IsolateDirResolved isoDir) tver forceInstall addConfArgs
GHCupInternal -> do -- regular install GHCupInternal -> do -- regular install
-- prepare paths -- prepare paths
ghcdir <- lift $ ghcupGHCDir tver ghcdir <- lift $ ghcupGHCDir tver
liftE $ installPackedGHC dl (view dlSubdir dlinfo) (GHCupDir ghcdir) ver forceInstall addConfArgs liftE $ installPackedGHC dl (view dlSubdir dlinfo) (GHCupDir ghcdir) tver forceInstall addConfArgs
-- make symlinks & stuff when regular install, -- make symlinks & stuff when regular install,
liftE $ postGHCInstall tver liftE $ postGHCInstall tver
@@ -375,7 +375,7 @@ installPackedGHC :: ( MonadMask m
=> FilePath -- ^ Path to the packed GHC bindist => FilePath -- ^ Path to the packed GHC bindist
-> Maybe TarDir -- ^ Subdir of the archive -> Maybe TarDir -- ^ Subdir of the archive
-> InstallDirResolved -> InstallDirResolved
-> Version -- ^ The GHC version -> GHCTargetVersion -- ^ The GHC version
-> Bool -- ^ Force install -> Bool -- ^ Force install
-> [T.Text] -- ^ additional configure args for bindist -> [T.Text] -- ^ additional configure args for bindist
-> Excepts -> Excepts
@@ -423,17 +423,17 @@ installUnpackedGHC :: ( MonadReader env m
) )
=> GHCupPath -- ^ Path to the unpacked GHC bindist (where the configure script resides) => GHCupPath -- ^ Path to the unpacked GHC bindist (where the configure script resides)
-> InstallDirResolved -- ^ Path to install to -> InstallDirResolved -- ^ Path to install to
-> Version -- ^ The GHC version -> GHCTargetVersion -- ^ The GHC version
-> Bool -- ^ Force install -> Bool -- ^ Force install
-> [T.Text] -- ^ additional configure args for bindist -> [T.Text] -- ^ additional configure args for bindist
-> Excepts '[ProcessError, MergeFileTreeError] m () -> Excepts '[ProcessError, MergeFileTreeError] m ()
installUnpackedGHC path inst ver forceInstall addConfArgs installUnpackedGHC path inst tver forceInstall addConfArgs
| isWindows = do | isWindows = do
lift $ logInfo "Installing GHC (this may take a while)" lift $ logInfo "Installing GHC (this may take a while)"
-- Windows bindists are relocatable and don't need -- Windows bindists are relocatable and don't need
-- to run configure. -- to run configure.
-- We also must make sure to preserve mtime to not confuse ghc-pkg. -- We also must make sure to preserve mtime to not confuse ghc-pkg.
liftE $ mergeFileTree path inst GHC (mkTVer ver) $ \source dest -> do liftE $ mergeFileTree path inst GHC tver $ \source dest -> do
mtime <- liftIO $ ifM (pathIsSymbolicLink source) (pure Nothing) (Just <$> getModificationTime source) mtime <- liftIO $ ifM (pathIsSymbolicLink source) (pure Nothing) (Just <$> getModificationTime source)
when forceInstall $ hideError doesNotExistErrorType $ hideError InappropriateType $ recycleFile dest when forceInstall $ hideError doesNotExistErrorType $ hideError InappropriateType $ recycleFile dest
liftIO $ moveFilePortable source dest liftIO $ moveFilePortable source dest
@@ -442,7 +442,7 @@ installUnpackedGHC path inst ver forceInstall addConfArgs
PlatformRequest {..} <- lift getPlatformReq PlatformRequest {..} <- lift getPlatformReq
let ldOverride let ldOverride
| ver >= [vver|8.2.2|] | _tvVersion tver >= [vver|8.2.2|]
, _rPlatform `elem` [Linux Alpine, Darwin] , _rPlatform `elem` [Linux Alpine, Darwin]
= ["--disable-ld-override"] = ["--disable-ld-override"]
| otherwise | otherwise
@@ -451,7 +451,7 @@ installUnpackedGHC path inst ver forceInstall addConfArgs
lift $ logInfo "Installing GHC (this may take a while)" lift $ logInfo "Installing GHC (this may take a while)"
lEM $ execLogged "sh" lEM $ execLogged "sh"
("./configure" : ("--prefix=" <> fromInstallDir inst) ("./configure" : ("--prefix=" <> fromInstallDir inst)
: (ldOverride <> (T.unpack <$> addConfArgs)) : (maybe mempty (\x -> ["--target=" <> T.unpack x]) (_tvTarget tver) <> ldOverride <> (T.unpack <$> addConfArgs))
) )
(Just $ fromGHCupPath path) (Just $ fromGHCupPath path)
"ghc-configure" "ghc-configure"
@@ -462,7 +462,7 @@ installUnpackedGHC path inst ver forceInstall addConfArgs
liftE $ mergeFileTree (tmpInstallDest `appendGHCupPath` dropDrive (fromInstallDir inst)) liftE $ mergeFileTree (tmpInstallDest `appendGHCupPath` dropDrive (fromInstallDir inst))
inst inst
GHC GHC
(mkTVer ver) tver
(\f t -> liftIO $ do (\f t -> liftIO $ do
mtime <- ifM (pathIsSymbolicLink f) (pure Nothing) (Just <$> getModificationTime f) mtime <- ifM (pathIsSymbolicLink f) (pure Nothing) (Just <$> getModificationTime f)
install f t (not forceInstall) install f t (not forceInstall)
@@ -489,7 +489,7 @@ installGHCBin :: ( MonadFail m
, MonadIO m , MonadIO m
, MonadUnliftIO m , MonadUnliftIO m
) )
=> Version -- ^ the version to install => GHCTargetVersion -- ^ the version to install
-> InstallDir -> InstallDir
-> Bool -- ^ force install -> Bool -- ^ force install
-> [T.Text] -- ^ additional configure args for bindist -> [T.Text] -- ^ additional configure args for bindist
@@ -512,9 +512,9 @@ installGHCBin :: ( MonadFail m
] ]
m m
() ()
installGHCBin ver installDir forceInstall addConfArgs = do installGHCBin tver installDir forceInstall addConfArgs = do
dlinfo <- liftE $ getDownloadInfo GHC ver dlinfo <- liftE $ getDownloadInfo' GHC tver
liftE $ installGHCBindist dlinfo ver installDir forceInstall addConfArgs liftE $ installGHCBindist dlinfo tver installDir forceInstall addConfArgs
@@ -755,7 +755,8 @@ compileGHC :: ( MonadMask m
, MonadUnliftIO m , MonadUnliftIO m
, MonadFail m , MonadFail m
) )
=> GHCVer GHCTargetVersion => GHCVer
-> Maybe Text -- ^ cross target
-> Maybe Version -- ^ overwrite version -> Maybe Version -- ^ overwrite version
-> Either Version FilePath -- ^ version to bootstrap with -> Either Version FilePath -- ^ version to bootstrap with
-> Maybe Int -- ^ jobs -> Maybe Int -- ^ jobs
@@ -792,19 +793,19 @@ compileGHC :: ( MonadMask m
] ]
m m
GHCTargetVersion GHCTargetVersion
compileGHC targetGhc ov bstrap jobs mbuildConfig patches aargs buildFlavour hadrian installDir compileGHC targetGhc crossTarget ov bstrap jobs mbuildConfig patches aargs buildFlavour hadrian installDir
= do = do
PlatformRequest { .. } <- lift getPlatformReq 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
-- unpack from version tarball -- unpack from version tarball
SourceDist tver -> do SourceDist ver -> do
lift $ logDebug $ "Requested to compile: " <> tVerToText tver <> " 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
dlInfo <- dlInfo <-
preview (ix GHC % ix (tver ^. tvVersion) % viSourceDL % _Just) dls preview (ix GHC % ix (mkTVer ver) % viSourceDL % _Just) dls
?? NoDownload ?? NoDownload
dl <- liftE $ downloadCached dlInfo Nothing dl <- liftE $ downloadCached dlInfo Nothing
@@ -818,7 +819,7 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patches aargs buildFlavour hadr
(view dlSubdir dlInfo) (view dlSubdir dlInfo)
liftE $ applyAnyPatch patches (fromGHCupPath workdir) liftE $ applyAnyPatch patches (fromGHCupPath workdir)
pure (workdir, tmpUnpack, Just tver) pure (workdir, tmpUnpack, Just (GHCTargetVersion crossTarget ver))
RemoteDist uri -> do RemoteDist uri -> do
lift $ logDebug $ "Requested to compile (from uri): " <> T.pack (show uri) lift $ logDebug $ "Requested to compile (from uri): " <> T.pack (show uri)
@@ -842,7 +843,7 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patches aargs buildFlavour hadr
let workdir = appendGHCupPath tmpUnpack (takeDirectory bf) let workdir = appendGHCupPath tmpUnpack (takeDirectory bf)
pure (workdir, tmpUnpack, mkTVer <$> tver) pure (workdir, tmpUnpack, GHCTargetVersion crossTarget <$> tver)
-- clone from git -- clone from git
GitDist GitBranch{..} -> do GitDist GitBranch{..} -> do
@@ -899,10 +900,10 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patches aargs buildFlavour hadr
pure tver pure tver
pure (tmpUnpack, tmpUnpack, mkTVer <$> tver) pure (tmpUnpack, tmpUnpack, GHCTargetVersion crossTarget <$> tver)
-- the version that's installed may differ from the -- the version that's installed may differ from the
-- compiled version, so the user can overwrite it -- compiled version, so the user can overwrite it
installVer <- if | Just ov' <- ov -> pure (mkTVer ov') installVer <- if | Just ov' <- ov -> pure (GHCTargetVersion crossTarget ov')
| Just tver' <- tver -> pure tver' | Just tver' <- tver -> pure tver'
| otherwise -> fail "Newer GHCs don't support discovering the version in git. Complain to GHC devs: https://gitlab.haskell.org/ghc/ghc/-/issues/22322" | otherwise -> fail "Newer GHCs don't support discovering the version in git. Complain to GHC devs: https://gitlab.haskell.org/ghc/ghc/-/issues/22322"
@@ -948,7 +949,7 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patches aargs buildFlavour hadr
liftE $ installPackedGHC bindist liftE $ installPackedGHC bindist
(Just $ RegexDir "ghc-.*") (Just $ RegexDir "ghc-.*")
ghcdir ghcdir
(installVer ^. tvVersion) installVer
False -- not a force install, since we already overwrite when compiling. False -- not a force install, since we already overwrite when compiling.
[] []
@@ -987,9 +988,9 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patches aargs buildFlavour hadr
defaultConf = defaultConf =
let cross_mk = $(LitE . StringL <$> (qAddDependentFile "data/build_mk/cross" >> runIO (readFile "data/build_mk/cross"))) let cross_mk = $(LitE . StringL <$> (qAddDependentFile "data/build_mk/cross" >> runIO (readFile "data/build_mk/cross")))
default_mk = $(LitE . StringL <$> (qAddDependentFile "data/build_mk/default" >> runIO (readFile "data/build_mk/default"))) default_mk = $(LitE . StringL <$> (qAddDependentFile "data/build_mk/default" >> runIO (readFile "data/build_mk/default")))
in case targetGhc of in case crossTarget of
SourceDist (GHCTargetVersion (Just _) _) -> cross_mk Just _ -> cross_mk
_ -> default_mk _ -> default_mk
compileHadrianBindist :: ( MonadReader env m compileHadrianBindist :: ( MonadReader env m
, HasDirs env , HasDirs env
@@ -1015,8 +1016,6 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patches aargs buildFlavour hadr
m m
(Maybe FilePath) -- ^ output path of bindist, None for cross (Maybe FilePath) -- ^ output path of bindist, None for cross
compileHadrianBindist tver workdir ghcdir = do compileHadrianBindist tver workdir ghcdir = do
lEM $ execWithGhcEnv "python3" ["./boot"] (Just workdir) "ghc-bootstrap"
liftE $ configureBindist tver workdir ghcdir liftE $ configureBindist tver workdir ghcdir
lift $ logInfo "Building (this may take a while)..." lift $ logInfo "Building (this may take a while)..."
@@ -1164,8 +1163,8 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patches aargs buildFlavour hadr
let lines' = fmap T.strip . T.lines $ decUTF8Safe c let lines' = fmap T.strip . T.lines $ decUTF8Safe c
-- for cross, we need Stage1Only -- for cross, we need Stage1Only
case targetGhc of case crossTarget of
SourceDist (GHCTargetVersion (Just _) _) -> when ("Stage1Only = YES" `notElem` lines') $ throwE Just _ -> when ("Stage1Only = YES" `notElem` lines') $ throwE
(InvalidBuildConfig (InvalidBuildConfig
[s|Cross compiling needs to be a Stage1 build, add "Stage1Only = YES" to your config!|] [s|Cross compiling needs to be a Stage1 build, add "Stage1Only = YES" to your config!|]
) )

View File

@@ -43,6 +43,7 @@ import Control.Monad.Trans.Resource
import Data.ByteString ( ByteString ) import Data.ByteString ( ByteString )
import Data.Either import Data.Either
import Data.List import Data.List
import Data.Ord
import Data.Maybe import Data.Maybe
import Data.String ( fromString ) import Data.String ( fromString )
import Data.Text ( Text ) import Data.Text ( Text )
@@ -368,7 +369,7 @@ compileHLS targetHLS ghcs jobs ov installDir cabalProject cabalProjectLocal upda
-- download source tarball -- download source tarball
dlInfo <- dlInfo <-
preview (ix HLS % ix tver % viSourceDL % _Just) dls preview (ix HLS % ix (mkTVer tver) % viSourceDL % _Just) dls
?? NoDownload ?? NoDownload
dl <- liftE $ downloadCached dlInfo Nothing dl <- liftE $ downloadCached dlInfo Nothing
@@ -704,7 +705,7 @@ rmHLSVer ver = do
when (Just ver == isHlsSet) $ do when (Just ver == isHlsSet) $ do
-- set latest hls -- set latest hls
hlsVers <- lift $ fmap rights getInstalledHLSs hlsVers <- lift $ fmap rights getInstalledHLSs
case headMay . reverse . sort $ hlsVers of case headMay . sortBy (comparing Down) $ hlsVers of
Just latestver -> liftE $ setHLS latestver SetHLSOnly Nothing Just latestver -> liftE $ setHLS latestver SetHLSOnly Nothing
Nothing -> pure () Nothing -> pure ()

View File

@@ -86,7 +86,7 @@ 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 VersionInfo availableToolVersions :: GHCupDownloads -> Tool -> Map.Map GHCTargetVersion VersionInfo
availableToolVersions av tool = view availableToolVersions av tool = view
(at tool % non Map.empty) (at tool % non Map.empty)
av av
@@ -134,13 +134,13 @@ listVersions lt' criteria hideOld showNightly days = do
slr <- strayGHCs avTools slr <- strayGHCs avTools
pure (sort (slr ++ lr)) pure (sort (slr ++ lr))
Cabal -> do Cabal -> do
slr <- strayCabals avTools cSet cabals slr <- strayCabals (Map.mapKeys _tvVersion avTools) cSet cabals
pure (sort (slr ++ lr)) pure (sort (slr ++ lr))
HLS -> do HLS -> do
slr <- strayHLS avTools hlsSet' hlses slr <- strayHLS (Map.mapKeys _tvVersion avTools) hlsSet' hlses
pure (sort (slr ++ lr)) pure (sort (slr ++ lr))
Stack -> do Stack -> do
slr <- strayStacks avTools sSet stacks slr <- strayStacks (Map.mapKeys _tvVersion avTools) sSet stacks
pure (sort (slr ++ lr)) pure (sort (slr ++ lr))
GHCup -> do GHCup -> do
let cg = maybeToList $ currentGHCup avTools let cg = maybeToList $ currentGHCup avTools
@@ -159,44 +159,29 @@ listVersions lt' criteria hideOld showNightly days = do
, HasLog env , HasLog env
, MonadIO m , MonadIO m
) )
=> Map.Map Version VersionInfo => Map.Map GHCTargetVersion VersionInfo
-> m [ListResult] -> m [ListResult]
strayGHCs avTools = do strayGHCs avTools = do
ghcs <- getInstalledGHCs ghcs <- getInstalledGHCs
fmap catMaybes $ forM ghcs $ \case fmap catMaybes $ forM ghcs $ \case
Right tver@GHCTargetVersion{ _tvTarget = Nothing, .. } -> do Right tver@GHCTargetVersion{ .. } -> do
case Map.lookup _tvVersion avTools of case Map.lookup tver avTools of
Just _ -> pure Nothing Just _ -> pure Nothing
Nothing -> do Nothing -> do
lSet <- fmap (maybe False (\(GHCTargetVersion _ v ) -> v == _tvVersion)) $ ghcSet Nothing lSet <- fmap (maybe False (\(GHCTargetVersion _ v ) -> v == _tvVersion)) $ ghcSet _tvTarget
fromSrc <- ghcSrcInstalled tver fromSrc <- ghcSrcInstalled tver
hlsPowered <- fmap (elem _tvVersion) hlsGHCVersions hlsPowered <- fmap (elem _tvVersion) hlsGHCVersions
pure $ Just $ ListResult pure $ Just $ ListResult
{ lTool = GHC { lTool = GHC
, lVer = _tvVersion , lVer = _tvVersion
, lCross = Nothing , lCross = _tvTarget
, lTag = [] , lTag = []
, lInstalled = True , lInstalled = True
, lStray = isNothing (Map.lookup _tvVersion avTools) , lStray = isNothing (Map.lookup tver avTools)
, lNoBindist = False , lNoBindist = False
, lReleaseDay = Nothing , lReleaseDay = Nothing
, .. , ..
} }
Right tver@GHCTargetVersion{ .. } -> do
lSet <- fmap (maybe False (\(GHCTargetVersion _ v ) -> v == _tvVersion)) $ ghcSet _tvTarget
fromSrc <- ghcSrcInstalled tver
hlsPowered <- fmap (elem _tvVersion) hlsGHCVersions
pure $ Just $ ListResult
{ lTool = GHC
, lVer = _tvVersion
, lCross = _tvTarget
, lTag = []
, lInstalled = True
, lStray = True -- NOTE: cross currently cannot be installed via bindist
, lNoBindist = False
, lReleaseDay = Nothing
, ..
}
Left e -> do Left e -> do
logWarn logWarn
$ "Could not parse version of stray directory" <> T.pack e $ "Could not parse version of stray directory" <> T.pack e
@@ -309,15 +294,15 @@ listVersions lt' criteria hideOld showNightly days = do
$ "Could not parse version of stray directory" <> T.pack e $ "Could not parse version of stray directory" <> T.pack e
pure Nothing pure Nothing
currentGHCup :: Map.Map Version VersionInfo -> Maybe ListResult currentGHCup :: Map.Map GHCTargetVersion VersionInfo -> Maybe ListResult
currentGHCup av = currentGHCup av =
let currentVer = fromJust $ pvpToVersion ghcUpVer "" let currentVer = mkTVer $ fromJust $ pvpToVersion ghcUpVer ""
listVer = Map.lookup currentVer av listVer = Map.lookup currentVer av
latestVer = fst <$> headOf (getTagged Latest) av latestVer = fst <$> headOf (getTagged Latest) av
recommendedVer = fst <$> headOf (getTagged Latest) av recommendedVer = fst <$> headOf (getTagged Latest) av
isOld = maybe True (> currentVer) latestVer && maybe True (> currentVer) recommendedVer isOld = maybe True (> currentVer) latestVer && maybe True (> currentVer) recommendedVer
in if | Map.member currentVer av -> Nothing in if | Map.member currentVer av -> Nothing
| otherwise -> Just $ ListResult { lVer = currentVer | otherwise -> Just $ ListResult { lVer = _tvVersion currentVer
, lTag = maybe (if isOld then [Old] else []) _viTags listVer , lTag = maybe (if isOld then [Old] else []) _viTags listVer
, lCross = Nothing , lCross = Nothing
, lTool = GHCup , lTool = GHCup
@@ -346,18 +331,18 @@ listVersions lt' criteria hideOld showNightly days = do
-> [Either FilePath Version] -> [Either FilePath Version]
-> Maybe Version -> Maybe Version
-> [Either FilePath Version] -> [Either FilePath Version]
-> (Version, VersionInfo) -> (GHCTargetVersion, VersionInfo)
-> m ListResult -> m ListResult
toListResult t cSet cabals hlsSet' hlses stackSet' stacks (v, VersionInfo{..}) = do toListResult t cSet cabals hlsSet' hlses stackSet' stacks (tver, VersionInfo{..}) = do
let v = _tvVersion tver
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 tver
let tver = mkTVer v lSet <- fmap (== Just tver) $ ghcSet (_tvTarget tver)
lSet <- fmap (maybe False (\(GHCTargetVersion _ v') -> v' == v)) $ ghcSet Nothing
lInstalled <- ghcInstalled tver lInstalled <- ghcInstalled tver
fromSrc <- ghcSrcInstalled tver fromSrc <- ghcSrcInstalled tver
hlsPowered <- fmap (elem v) hlsGHCVersions hlsPowered <- fmap (elem tver) (fmap mkTVer <$> hlsGHCVersions)
pure ListResult { lVer = v, lCross = Nothing , lTag = _viTags, lTool = t, lStray = False, lReleaseDay = _viReleaseDay, .. } pure ListResult { lVer = _tvVersion tver , lCross = _tvTarget tver , lTag = _viTags, lTool = t, lStray = False, lReleaseDay = _viReleaseDay, .. }
Cabal -> do Cabal -> do
lNoBindist <- fmap (isLeft . veitherToEither) $ runE @'[NoDownload] $ getDownloadInfo Cabal v lNoBindist <- fmap (isLeft . veitherToEither) $ runE @'[NoDownload] $ getDownloadInfo Cabal v
let lSet = cSet == Just v let lSet = cSet == Just v

View File

@@ -38,6 +38,7 @@ import Control.Monad.Trans.Resource
hiding ( throwM ) hiding ( throwM )
import Data.Either import Data.Either
import Data.List import Data.List
import Data.Ord
import Data.Maybe import Data.Maybe
import Data.Versions hiding ( patch ) import Data.Versions hiding ( patch )
import Haskus.Utils.Variant.Excepts import Haskus.Utils.Variant.Excepts
@@ -279,6 +280,6 @@ rmStackVer ver = do
when (Just ver == sSet) $ do when (Just ver == sSet) $ do
sVers <- lift $ fmap rights getInstalledStacks sVers <- lift $ fmap rights getInstalledStacks
case headMay . reverse . sort $ sVers of case headMay . sortBy (comparing Down) $ sVers of
Just latestver -> setStack latestver Just latestver -> setStack latestver
Nothing -> lift $ rmLink (binDir </> "stack" <> exeExt) Nothing -> lift $ rmLink (binDir </> "stack" <> exeExt)

View File

@@ -104,7 +104,7 @@ instance NFData Requirements
-- | Description of all binary and source downloads. This is a tree -- | Description of all binary and source downloads. This is a tree
-- of nested maps. -- of nested maps.
type GHCupDownloads = Map Tool ToolVersionSpec type GHCupDownloads = Map Tool ToolVersionSpec
type ToolVersionSpec = Map Version VersionInfo type ToolVersionSpec = Map GHCTargetVersion VersionInfo
type ArchitectureSpec = Map Architecture PlatformSpec type ArchitectureSpec = Map Architecture PlatformSpec
type PlatformSpec = Map Platform PlatformVersionSpec type PlatformSpec = Map Platform PlatformVersionSpec
type PlatformVersionSpec = Map (Maybe VersionRange) DownloadInfo type PlatformVersionSpec = Map (Maybe VersionRange) DownloadInfo
@@ -593,7 +593,9 @@ data GHCTargetVersion = GHCTargetVersion
{ _tvTarget :: Maybe Text { _tvTarget :: Maybe Text
, _tvVersion :: Version , _tvVersion :: Version
} }
deriving (Ord, Eq, Show) deriving (Ord, Eq, Show, GHC.Generic)
instance NFData GHCTargetVersion
data GitBranch = GitBranch data GitBranch = GitBranch
{ ref :: String { ref :: String

View File

@@ -95,13 +95,29 @@ instance FromJSON URI where
Right x -> pure x Right x -> pure x
Left e -> fail . show $ e Left e -> fail . show $ e
instance ToJSON GHCTargetVersion where
toJSON = toJSON . tVerToText
instance FromJSON GHCTargetVersion where
parseJSON = withText "GHCTargetVersion" $ \t -> case MP.parse ghcTargetVerP "" t of
Right x -> pure x
Left e -> fail $ "Failure in GHCTargetVersion (FromJSON)" <> show e
instance ToJSONKey GHCTargetVersion where
toJSONKey = toJSONKeyText $ \x -> tVerToText x
instance FromJSONKey GHCTargetVersion where
fromJSONKey = FromJSONKeyTextParser $ \t -> case MP.parse ghcTargetVerP "" t of
Right x -> pure x
Left e -> fail $ "Failure in GHCTargetVersion (FromJSONKey)" <> show e
instance ToJSON Versioning where instance ToJSON Versioning where
toJSON = toJSON . prettyV toJSON = toJSON . prettyV
instance FromJSON Versioning where instance FromJSON Versioning where
parseJSON = withText "Versioning" $ \t -> case versioning t of parseJSON = withText "Versioning" $ \t -> case versioning t of
Right x -> pure x Right x -> pure x
Left e -> fail $ "Failure in Version (FromJSON)" <> show e Left e -> fail $ "Failure in GHCTargetVersion (FromJSON)" <> show e
instance ToJSONKey Versioning where instance ToJSONKey Versioning where
toJSONKey = toJSONKeyText $ \x -> prettyV x toJSONKey = toJSONKeyText $ \x -> prettyV x

View File

@@ -62,7 +62,6 @@ import Control.Monad.Trans.Resource
hiding ( throwM ) hiding ( throwM )
import Control.Monad.IO.Unlift ( MonadUnliftIO( withRunInIO ) ) import Control.Monad.IO.Unlift ( MonadUnliftIO( withRunInIO ) )
import Data.Char ( isHexDigit ) import Data.Char ( isHexDigit )
import Data.Bifunctor ( first )
import Data.ByteString ( ByteString ) import Data.ByteString ( ByteString )
import Data.Either import Data.Either
import Data.Foldable import Data.Foldable
@@ -774,13 +773,16 @@ getGHCForPVP' pvpIn ghcs' mt = do
-- Just (PVP {_pComponents = 8 :| [8,4]}) -- Just (PVP {_pComponents = 8 :| [8,4]})
getLatestToolFor :: MonadThrow m getLatestToolFor :: MonadThrow m
=> Tool => Tool
-> Maybe Text
-> PVP -> PVP
-> GHCupDownloads -> GHCupDownloads
-> m (Maybe (PVP, VersionInfo)) -> m (Maybe (PVP, VersionInfo, Maybe Text))
getLatestToolFor tool pvpIn dls = do getLatestToolFor tool target pvpIn dls = do
let ls = fromMaybe [] $ preview (ix tool % to Map.toDescList) dls let ls :: [(GHCTargetVersion, VersionInfo)]
let ps = catMaybes $ fmap (\(v, vi) -> (,vi) <$> versionToPVP v) ls ls = fromMaybe [] $ preview (ix tool % to Map.toDescList) dls
pure . fmap (first fst) . headMay . filter (\((v, _), _) -> matchPVPrefix pvpIn v) $ ps let ps :: [((PVP, Text), VersionInfo, Maybe Text)]
ps = catMaybes $ fmap (\(v, vi) -> (,vi, _tvTarget v) <$> versionToPVP (_tvVersion v)) ls
pure . fmap (\((pv', _), vi, mt) -> (pv', vi, mt)) . headMay . filter (\((v, _), _, t) -> matchPVPrefix pvpIn v && t == target) $ ps
@@ -885,12 +887,12 @@ intoSubdir bdir tardir = case tardir of
-- | Get the tool version that has this tag. If multiple have it, -- | Get the tool version that has this tag. If multiple have it,
-- picks the greatest version. -- picks the greatest version.
getTagged :: Tag getTagged :: Tag
-> Fold (Map.Map Version VersionInfo) (Version, VersionInfo) -> Fold (Map.Map GHCTargetVersion VersionInfo) (GHCTargetVersion, VersionInfo)
getTagged tag = getTagged tag =
to (Map.toDescList . Map.filter (\VersionInfo {..} -> tag `elem` _viTags)) to (Map.toDescList . Map.filter (\VersionInfo {..} -> tag `elem` _viTags))
% folding id % folding id
getByReleaseDay :: GHCupDownloads -> Tool -> Day -> Either (Maybe Day) (Version, VersionInfo) getByReleaseDay :: GHCupDownloads -> Tool -> Day -> Either (Maybe Day) (GHCTargetVersion, VersionInfo)
getByReleaseDay av tool day = let mvv = fromMaybe mempty $ headOf (ix tool) av getByReleaseDay av tool day = let mvv = fromMaybe mempty $ headOf (ix tool) av
mdv = Map.foldrWithKey (\k vi@VersionInfo{..} m -> mdv = Map.foldrWithKey (\k vi@VersionInfo{..} m ->
maybe m (\d -> let diff = diffDays d day maybe m (\d -> let diff = diffDays d day
@@ -902,24 +904,24 @@ getByReleaseDay av tool day = let mvv = fromMaybe mempty $ headOf (ix tool) av
| absDiff == 0 -> Right (k, vi) | absDiff == 0 -> Right (k, vi)
| otherwise -> Left (Just (addDays diff day)) | otherwise -> Left (Just (addDays diff day))
getByReleaseDayFold :: Day -> Fold (Map.Map Version VersionInfo) (Version, VersionInfo) getByReleaseDayFold :: Day -> Fold (Map.Map GHCTargetVersion VersionInfo) (GHCTargetVersion, VersionInfo)
getByReleaseDayFold day = to (Map.toDescList . Map.filter (\VersionInfo {..} -> Just day == _viReleaseDay)) % folding id getByReleaseDayFold day = to (Map.toDescList . Map.filter (\VersionInfo {..} -> Just day == _viReleaseDay)) % folding id
getLatest :: GHCupDownloads -> Tool -> Maybe (Version, VersionInfo) getLatest :: GHCupDownloads -> Tool -> Maybe (GHCTargetVersion, VersionInfo)
getLatest av tool = headOf (ix tool % getTagged Latest) av getLatest av tool = headOf (ix tool % getTagged Latest) av
getLatestPrerelease :: GHCupDownloads -> Tool -> Maybe (Version, VersionInfo) getLatestPrerelease :: GHCupDownloads -> Tool -> Maybe (GHCTargetVersion, VersionInfo)
getLatestPrerelease av tool = headOf (ix tool % getTagged LatestPrerelease) av getLatestPrerelease av tool = headOf (ix tool % getTagged LatestPrerelease) av
getLatestNightly :: GHCupDownloads -> Tool -> Maybe (Version, VersionInfo) getLatestNightly :: GHCupDownloads -> Tool -> Maybe (GHCTargetVersion, VersionInfo)
getLatestNightly av tool = headOf (ix tool % getTagged LatestNightly) av getLatestNightly av tool = headOf (ix tool % getTagged LatestNightly) av
getRecommended :: GHCupDownloads -> Tool -> Maybe (Version, VersionInfo) getRecommended :: GHCupDownloads -> Tool -> Maybe (GHCTargetVersion, VersionInfo)
getRecommended av tool = headOf (ix tool % getTagged Recommended) av getRecommended av tool = headOf (ix tool % getTagged Recommended) av
-- | Gets the latest GHC with a given base version. -- | Gets the latest GHC with a given base version.
getLatestBaseVersion :: GHCupDownloads -> PVP -> Maybe (Version, VersionInfo) getLatestBaseVersion :: GHCupDownloads -> PVP -> Maybe (GHCTargetVersion, VersionInfo)
getLatestBaseVersion av pvpVer = getLatestBaseVersion av pvpVer =
headOf (ix GHC % getTagged (Base pvpVer)) av headOf (ix GHC % getTagged (Base pvpVer)) av
@@ -1101,9 +1103,9 @@ darwinNotarization _ _ = pure $ Right ()
getChangeLog :: GHCupDownloads -> Tool -> ToolVersion -> Maybe URI getChangeLog :: GHCupDownloads -> Tool -> ToolVersion -> Maybe URI
getChangeLog dls tool (GHCVersion (_tvVersion -> v')) = getChangeLog dls tool (GHCVersion v') =
preview (ix tool % ix v' % viChangeLog % _Just) dls preview (ix tool % ix v' % viChangeLog % _Just) dls
getChangeLog dls tool (ToolVersion v') = getChangeLog dls tool (ToolVersion (mkTVer -> v')) =
preview (ix tool % ix v' % viChangeLog % _Just) dls preview (ix tool % ix v' % viChangeLog % _Just) dls
getChangeLog dls tool (ToolTag tag) = getChangeLog dls tool (ToolTag tag) =
preview (ix tool % pre (getTagged tag) % to snd % viChangeLog % _Just) dls preview (ix tool % pre (getTagged tag) % to snd % viChangeLog % _Just) dls
@@ -1192,7 +1194,7 @@ rmBDir dir = withRunInIO (\run -> run $
$ rmPathForcibly dir) $ rmPathForcibly dir)
getVersionInfo :: Version getVersionInfo :: GHCTargetVersion
-> Tool -> Tool
-> GHCupDownloads -> GHCupDownloads
-> Maybe VersionInfo -> Maybe VersionInfo

View File

@@ -52,7 +52,7 @@ versionCmp ver1 (VR_lteq ver2) = ver1 <= ver2
versionCmp ver1 (VR_eq ver2) = ver1 == ver2 versionCmp ver1 (VR_eq ver2) = ver1 == ver2
versionRange :: V.Versioning -> VersionRange -> Bool versionRange :: V.Versioning -> VersionRange -> Bool
versionRange ver' (SimpleRange cmps) = and $ fmap (versionCmp ver') cmps versionRange ver' (SimpleRange cmps) = all (versionCmp ver') cmps
versionRange ver' (OrRange cmps range) = versionRange ver' (OrRange cmps range) =
versionRange ver' (SimpleRange cmps) || versionRange ver' range versionRange ver' (SimpleRange cmps) || versionRange ver' range

View File

@@ -28,7 +28,7 @@
plat="$(uname -s)" plat="$(uname -s)"
arch=$(uname -m) arch=$(uname -m)
ghver="0.1.19.2" ghver="0.1.19.4"
: "${GHCUP_BASE_URL:=https://downloads.haskell.org/~ghcup}" : "${GHCUP_BASE_URL:=https://downloads.haskell.org/~ghcup}"
export GHCUP_SKIP_UPDATE_CHECK=yes export GHCUP_SKIP_UPDATE_CHECK=yes

View File

@@ -0,0 +1,67 @@
#!/bin/bash
set -eu
set -o pipefail
RELEASE=$1
get_sha() {
sha256sum "$1" | awk '{ print $1 }'
}
cd "gh-release-artifacts/v${RELEASE}"
cat <<EOF > /dev/stdout
GHCup:
${RELEASE}:
viTags:
- Recommended
- Latest
viChangeLog: https://github.com/haskell/ghcup-hs/blob/master/CHANGELOG.md
viSourceDL:
dlUri: https://downloads.haskell.org/~ghcup/${RELEASE}/ghcup-${RELEASE}-src.tar.gz
dlSubdir: ghcup-${RELEASE}
dlHash: $(get_sha "ghcup-${RELEASE}-src.tar.gz")
viArch:
A_64:
Linux_UnknownLinux:
unknown_versioning: &ghcup-64
dlUri: https://downloads.haskell.org/~ghcup/${RELEASE}/x86_64-linux-ghcup-${RELEASE}
dlHash: $(get_sha "x86_64-linux-ghcup-${RELEASE}")
Darwin:
unknown_versioning:
dlUri: https://downloads.haskell.org/~ghcup/${RELEASE}/x86_64-apple-darwin-ghcup-${RELEASE}
dlHash: $(get_sha "x86_64-apple-darwin-ghcup-${RELEASE}")
FreeBSD:
unknown_versioning:
dlUri: https://downloads.haskell.org/~ghcup/${RELEASE}/x86_64-portbld-freebsd-ghcup-${RELEASE}
dlHash: $(get_sha "x86_64-portbld-freebsd-ghcup-${RELEASE}")
Windows:
unknown_versioning:
dlUri: https://downloads.haskell.org/~ghcup/${RELEASE}/x86_64-mingw64-ghcup-${RELEASE}.exe
dlHash: $(get_sha "x86_64-mingw64-ghcup-${RELEASE}.exe")
Linux_Alpine:
unknown_versioning: *ghcup-64
A_32:
Linux_UnknownLinux:
unknown_versioning: &ghcup-32
dlUri: https://downloads.haskell.org/~ghcup/${RELEASE}/i386-linux-ghcup-${RELEASE}
dlHash: $(get_sha "i386-linux-ghcup-${RELEASE}")
Linux_Alpine:
unknown_versioning: *ghcup-32
A_ARM64:
Linux_UnknownLinux:
unknown_versioning:
dlUri: https://downloads.haskell.org/~ghcup/${RELEASE}/aarch64-linux-ghcup-${RELEASE}
dlHash: $(get_sha "aarch64-linux-ghcup-${RELEASE}")
Darwin:
unknown_versioning:
dlUri: https://downloads.haskell.org/~ghcup/${RELEASE}/aarch64-apple-darwin-ghcup-${RELEASE}
dlHash: $(get_sha "aarch64-apple-darwin-ghcup-${RELEASE}")
A_ARM:
Linux_UnknownLinux:
unknown_versioning:
dlUri: https://downloads.haskell.org/~ghcup/${RELEASE}/armv7-linux-ghcup-${RELEASE}
dlHash: $(get_sha "armv7-linux-ghcup-${RELEASE}")
EOF

View File

@@ -183,6 +183,10 @@ instance Arbitrary GHCupInfo where
arbitrary = genericArbitrary arbitrary = genericArbitrary
shrink = genericShrink shrink = genericShrink
instance Arbitrary GHCTargetVersion where
arbitrary = GHCTargetVersion Nothing <$> arbitrary
shrink = genericShrink
-- our maps are nested... the default size easily blows up most ppls ram -- our maps are nested... the default size easily blows up most ppls ram