Compare commits

...

38 Commits

Author SHA1 Message Date
ff60744cc6 WIP 2023-05-01 16:01:57 +08:00
e0222b4007 First draft of implementing revisions 2023-02-27 13:39:48 +08:00
784942ca58 Update submodule 2023-02-24 20:03:25 +08:00
75de2a7bc1 Merge branch 'ghcup-0.1.19.2' 2023-02-24 20:03:14 +08:00
ea6c8d338c Bump ghcup in bootstrap script 2023-02-24 19:52:50 +08:00
ae625b181c Improve pull_release_artifacts 2023-02-24 19:52:41 +08:00
89ae54a083 Set release date 2023-02-24 00:00:29 +08:00
1bd73591ba Update data/metadata 2023-02-23 23:58:16 +08:00
f709f6e714 Update ChangeLog 2023-02-23 23:56:46 +08:00
3d7e07c371 Merge branch 'issue-796' 2023-02-23 23:52:38 +08:00
8bf17379ac Fix windows bootstrap, fixes #796 2023-02-23 23:41:25 +08:00
4b1225ad71 Merge branch 'issue-797' 2023-02-23 23:15:48 +08:00
d628848af6 Silence hlint 2023-02-23 23:15:08 +08:00
48381be001 Bump GHC 9.2.5 to 9.2.6 2023-02-23 23:07:46 +08:00
b547324253 Smarter variants for 'listDirectory', fixing #797 2023-02-23 21:47:50 +08:00
2b1599c234 Fix windows golden file 2023-02-23 20:57:40 +08:00
7ac8989dfc Bump to 0.1.19.2 2023-02-21 23:01:08 +08:00
cd6666ed30 Merge branch 'latest-prerelease' 2023-02-21 23:00:47 +08:00
5b7478438a Merge branch 'issue-787' 2023-02-21 23:00:31 +08:00
4a830d9fb7 Fix regression in JFS support, fixes #787 2023-02-21 22:48:22 +08:00
785fb895b4 Implement 'latest-prerelease' tag wrt #788 2023-02-21 22:22:11 +08:00
75e801e9e6 Merge branch 'ghcup-0.1.19.1' 2023-02-20 00:03:26 +08:00
6ffd5328a4 Improve sftp-symlink-artifacts.sh 2023-02-20 00:01:11 +08:00
ed509e482b Improve pull_release_artifacts 2023-02-19 23:58:25 +08:00
420323f43b Update bootstrap script to 0.1.19.1 2023-02-19 23:58:07 +08:00
432962792c Update ghcup-metadata 2023-02-19 22:56:33 +08:00
cb193f6069 Update ChangeLog for 0.1.19.1 2023-02-19 22:55:47 +08:00
2f268b6a25 Bump GHCup version 2023-02-19 22:44:28 +08:00
580606af14 Merge remote-tracking branch 'origin/pr/773' 2023-02-19 22:42:08 +08:00
faa1c3992b Merge branch 'issue-762' 2023-02-19 22:41:27 +08:00
d17efef853 Merge branch 'issue-784' 2023-02-19 21:38:41 +08:00
179d4dd493 Fixup 2023-02-19 19:33:01 +08:00
5fa10390a3 Fix CI 2023-02-19 19:15:09 +08:00
e1e6f579d5 Use debian:10 rather 2023-02-19 18:48:42 +08:00
6cf9967e7c Work around missing libtinfo.so.6 2023-02-12 18:41:40 +08:00
15a75d790a Build arm binaries in bionic images, fixes #762 2023-02-12 17:16:32 +08:00
988672ea75 Build arm images for bionic as well wrh #762 2023-02-12 17:16:27 +08:00
ksqsf
9baba88f75 Add a known mirror 2023-02-08 22:09:04 +08:00
42 changed files with 22472 additions and 21596 deletions

View File

@@ -129,6 +129,27 @@ build_with_cache() {
} }
install_ghcup() { install_ghcup() {
case "${RUNNER_OS}" in
"Linux")
case "${ARCH}" in
"ARM"*)
if command -v ghcup ; then
mkdir -p "$GHCUP_BIN"
cp "$(command -v ghcup)" "$GHCUP_BIN/ghcup${ext}"
else
install_ghcup_curl_sh
fi
;;
*) install_ghcup_curl_sh
;;
esac
;;
*) install_ghcup_curl_sh
;;
esac
}
install_ghcup_curl_sh() {
curl --proto '=https' --tlsv1.2 -sSf https://get-ghcup.haskell.org | BOOTSTRAP_HASKELL_NONINTERACTIVE=1 BOOTSTRAP_HASKELL_MINIMAL=1 BOOTSTRAP_HASKELL_INSTALL_NO_STACK=yes sh curl --proto '=https' --tlsv1.2 -sSf https://get-ghcup.haskell.org | BOOTSTRAP_HASKELL_NONINTERACTIVE=1 BOOTSTRAP_HASKELL_MINIMAL=1 BOOTSTRAP_HASKELL_INSTALL_NO_STACK=yes sh
} }

View File

@@ -51,5 +51,8 @@ jobs:
- if: runner.os == 'Windows' - if: runner.os == 'Windows'
name: Run bootstrap name: Run bootstrap
run: ./scripts/bootstrap/bootstrap-haskell.ps1 -InstallDir ${GITHUB_WORKSPACE} -BootstrapUrl ${GITHUB_WORKSPACE}/bootstrap-haskell -InBash run: |
$curDir = Get-Location
Write-Host "Current Working Directory: $curDir"
./scripts/bootstrap/bootstrap-haskell.ps1 -InstallDir ${GITHUB_WORKSPACE} -BootstrapUrl ("{0}/scripts/bootstrap/bootstrap-haskell" -f $curDir) -InBash
shell: pwsh shell: pwsh

View File

@@ -72,12 +72,20 @@ jobs:
username: ${{ secrets.DOCKERHUB_USERNAME }} username: ${{ secrets.DOCKERHUB_USERNAME }}
password: ${{ secrets.DOCKERHUB_TOKEN }} password: ${{ secrets.DOCKERHUB_TOKEN }}
- name: Build and push - name: Build and push (debian buster)
uses: docker/build-push-action@v3 uses: docker/build-push-action@v3
with: with:
context: ./docker/arm32v7 context: ./docker/arm32v7/buster
push: true push: true
tags: hasufell/arm32v7-ubuntu-haskell:focal tags: hasufell/arm32v7-debian-haskell:10
platforms: linux/arm
- name: Build and push (ubuntu focal)
uses: docker/build-push-action@v3
with:
context: ./docker/arm32v7/focal
push: true
tags: hasufell/arm32v7-debian-haskell:10
platforms: linux/arm platforms: linux/arm
docker-aarch: docker-aarch:
@@ -100,10 +108,18 @@ jobs:
username: ${{ secrets.DOCKERHUB_USERNAME }} username: ${{ secrets.DOCKERHUB_USERNAME }}
password: ${{ secrets.DOCKERHUB_TOKEN }} password: ${{ secrets.DOCKERHUB_TOKEN }}
- name: Build and push - name: Build and push (debian buster)
uses: docker/build-push-action@v3 uses: docker/build-push-action@v3
with: with:
context: ./docker/arm64v8/ context: ./docker/arm64v8/buster
push: true push: true
tags: hasufell/arm64v8-ubuntu-haskell:focal tags: hasufell/arm64v8-debian-haskell:10
platforms: linux/arm64
- name: Build and push (ubuntu focal)
uses: docker/build-push-action@v3
with:
context: ./docker/arm64v8/focal
push: true
tags: hasufell/arm64v8-debian-haskell:10
platforms: linux/arm64 platforms: linux/arm64

View File

@@ -96,10 +96,10 @@ jobs:
ARCH: ARM ARCH: ARM
- os: [self-hosted, Linux, ARM64] - os: [self-hosted, Linux, ARM64]
ARTIFACT: "aarch64-linux-ghcup" ARTIFACT: "aarch64-linux-ghcup"
GHC_VER: 9.2.5 GHC_VER: 9.2.6
ARCH: ARM64 ARCH: ARM64
steps: steps:
- uses: docker://arm64v8/ubuntu:focal - uses: docker://arm64v8/debian:10
name: Cleanup (aarch64 linux) name: Cleanup (aarch64 linux)
with: with:
args: "find . -mindepth 1 -maxdepth 1 -exec rm -rf -- {} +" args: "find . -mindepth 1 -maxdepth 1 -exec rm -rf -- {} +"
@@ -115,7 +115,7 @@ jobs:
submodules: 'true' submodules: 'true'
- if: matrix.ARCH == 'ARM' - if: matrix.ARCH == 'ARM'
uses: docker://hasufell/arm32v7-ubuntu-haskell:focal uses: docker://hasufell/arm32v7-debian-haskell:10
name: Run build (armv7 linux) name: Run build (armv7 linux)
with: with:
args: sh .github/scripts/build.sh args: sh .github/scripts/build.sh
@@ -129,7 +129,7 @@ jobs:
S3_HOST: ${{ env.S3_HOST }} S3_HOST: ${{ env.S3_HOST }}
- if: matrix.ARCH == 'ARM64' - if: matrix.ARCH == 'ARM64'
uses: docker://hasufell/arm64v8-ubuntu-haskell:focal uses: docker://hasufell/arm64v8-debian-haskell:10
name: Run build (aarch64 linux) name: Run build (aarch64 linux)
with: with:
args: sh .github/scripts/build.sh args: sh .github/scripts/build.sh
@@ -166,11 +166,11 @@ jobs:
include: include:
- os: [self-hosted, macOS, ARM64] - os: [self-hosted, macOS, ARM64]
ARTIFACT: "aarch64-apple-darwin-ghcup" ARTIFACT: "aarch64-apple-darwin-ghcup"
GHC_VER: 9.2.5 GHC_VER: 9.2.6
ARCH: ARM64 ARCH: ARM64
- os: macOS-10.15 - os: macOS-10.15
ARTIFACT: "x86_64-apple-darwin-ghcup" ARTIFACT: "x86_64-apple-darwin-ghcup"
GHC_VER: 9.2.5 GHC_VER: 9.2.6
ARCH: 64 ARCH: 64
- os: windows-latest - os: windows-latest
ARTIFACT: "x86_64-mingw64-ghcup" ARTIFACT: "x86_64-mingw64-ghcup"
@@ -337,12 +337,12 @@ jobs:
DISTRO: Ubuntu DISTRO: Ubuntu
- os: [self-hosted, Linux, ARM64] - os: [self-hosted, Linux, ARM64]
ARTIFACT: "aarch64-linux-ghcup" ARTIFACT: "aarch64-linux-ghcup"
GHC_VER: 9.2.5 GHC_VER: 9.2.6
ARCH: ARM64 ARCH: ARM64
DISTRO: Ubuntu DISTRO: Ubuntu
steps: steps:
- uses: docker://arm64v8/ubuntu:focal - uses: docker://arm64v8/debian:10
name: Cleanup (aarch64 linux) name: Cleanup (aarch64 linux)
with: with:
args: "find . -mindepth 1 -maxdepth 1 -exec rm -rf -- {} +" args: "find . -mindepth 1 -maxdepth 1 -exec rm -rf -- {} +"
@@ -358,7 +358,7 @@ jobs:
path: ./out path: ./out
- if: matrix.ARCH == 'ARM' - if: matrix.ARCH == 'ARM'
uses: docker://hasufell/arm32v7-ubuntu-haskell:focal uses: docker://hasufell/arm32v7-debian-haskell:10
name: Run test (armv7 linux) name: Run test (armv7 linux)
with: with:
args: sh .github/scripts/test.sh args: sh .github/scripts/test.sh
@@ -369,7 +369,7 @@ jobs:
DISTRO: Ubuntu DISTRO: Ubuntu
- if: matrix.ARCH == 'ARM64' - if: matrix.ARCH == 'ARM64'
uses: docker://hasufell/arm64v8-ubuntu-haskell:focal uses: docker://hasufell/arm64v8-debian-haskell:10
name: Run test (aarch64 linux) name: Run test (aarch64 linux)
with: with:
args: sh .github/scripts/test.sh args: sh .github/scripts/test.sh
@@ -400,12 +400,12 @@ jobs:
include: include:
- os: [self-hosted, macOS, ARM64] - os: [self-hosted, macOS, ARM64]
ARTIFACT: "aarch64-apple-darwin-ghcup" ARTIFACT: "aarch64-apple-darwin-ghcup"
GHC_VER: 9.2.5 GHC_VER: 9.2.6
ARCH: ARM64 ARCH: ARM64
DISTRO: na DISTRO: na
- os: macOS-10.15 - os: macOS-10.15
ARTIFACT: "x86_64-apple-darwin-ghcup" ARTIFACT: "x86_64-apple-darwin-ghcup"
GHC_VER: 9.2.5 GHC_VER: 9.2.6
ARCH: 64 ARCH: 64
DISTRO: na DISTRO: na
- os: windows-latest - os: windows-latest

View File

@@ -1,5 +1,22 @@
# Revision history for ghcup # Revision history for ghcup
## 0.1.19.2 -- 2023-2-24
* Follow-up fix for JFS/ReiserFS and other filesystem that don't support `d_type`, fixes [#787](https://github.com/haskell/ghcup-hs/issues/787)
- the previous release had a bug that invalidated that broke it
* Implement 'latest-prerelease' tag wrt [#788](https://github.com/haskell/ghcup-hs/issues/788)
* Fix 'Could not parse version of stray directory.DS_Store' warnings on macOs wrt [#797](https://github.com/haskell/ghcup-hs/issues/797)
## 0.1.19.1 -- 2023-2-19
* Fix GHCup on JFS/ReiserFS and other filesystem that don't support `d_type`, fixes [#766](https://github.com/haskell/ghcup-hs/issues/766)
* Don't fail on setModificationTime, fixes [#784](https://github.com/haskell/ghcup-hs/issues/784) and many GitHub actions issues
* Make armv7/aarch64 linux binaries more portable (built on Debian buster)
* Improve usability on 'ghcup config add-release-channel', fixes [#751](https://github.com/haskell/ghcup-hs/issues/751)
* Make version shortcuts work with 'ghcup set', fixes [#757](https://github.com/haskell/ghcup-hs/issues/757)
* Don't implicitly smuggle in config options in `ghcup config set` wrt [#775](https://github.com/haskell/ghcup-hs/issues/775)
* Fix build on unix with -ftui
## 0.1.19.0 -- 2023-1-13 ## 0.1.19.0 -- 2023-1-13
* restore proper support for FreeBSD and Linux armv7 * restore proper support for FreeBSD and Linux armv7

View File

@@ -4,13 +4,13 @@
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeApplications #-}
{-# LANGUAGE RankNTypes #-} {-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ViewPatterns #-}
module BrickMain where module BrickMain where
import GHCup import GHCup
import GHCup.Download import GHCup.Download
import GHCup.Errors import GHCup.Errors
import GHCup.Types.Optics ( getDirs )
import GHCup.Types hiding ( LeanAppState(..) ) import GHCup.Types hiding ( LeanAppState(..) )
import GHCup.Utils import GHCup.Utils
import GHCup.OptParse.Common (logGHCPostRm) import GHCup.OptParse.Common (logGHCPostRm)
@@ -19,6 +19,7 @@ import GHCup.Prelude.File
import GHCup.Prelude.Logger import GHCup.Prelude.Logger
import GHCup.Prelude.Process import GHCup.Prelude.Process
import GHCup.Prompts import GHCup.Prompts
import GHCup.Types.Optics hiding ( getGHCupInfo )
import Brick import Brick
import Brick.Widgets.Border import Brick.Widgets.Border
@@ -52,6 +53,7 @@ import System.Exit
import System.IO.Unsafe import System.IO.Unsafe
import Text.PrettyPrint.HughesPJClass ( prettyShow ) import Text.PrettyPrint.HughesPJClass ( prettyShow )
import URI.ByteString import URI.ByteString
import Optics ( view )
import qualified Data.Text as T import qualified Data.Text as T
import qualified Data.Text.Lazy.Builder as B import qualified Data.Text.Lazy.Builder as B
@@ -154,8 +156,11 @@ ui dimAttrs BrickState{ appSettings = as@BrickSettings{}, ..}
<+> minHSize 15 (str "Version") <+> minHSize 15 (str "Version")
<+> 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' = withDefAttr listAttr . drawListElements renderItem True renderList' bis@BrickInternalState{..} =
renderItem _ b listResult@ListResult{..} = let getMinLength = length . intercalate "," . fmap tagToString
minLength = V.maximum $ V.map (getMinLength . lTag) clr
in withDefAttr listAttr . drawListElements (renderItem minLength) True $ bis
renderItem minTagSize _ 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 "")
@@ -170,7 +175,7 @@ ui dimAttrs BrickState{ appSettings = as@BrickSettings{}, ..}
= updateAttrMap (const dimAttrs) . withAttr (attrName "no-bindist") = updateAttrMap (const dimAttrs) . withAttr (attrName "no-bindist")
| otherwise = id | otherwise = id
hooray hooray
| elem Latest lTag && not lInstalled = | elem Latest lTag' && not lInstalled =
withAttr (attrName "hooray") withAttr (attrName "hooray")
| otherwise = id | otherwise = id
active = if b then putCursor "GHCup" (Location (0,0)) . forceAttr (attrName "active") else id active = if b then putCursor "GHCup" (Location (0,0)) . forceAttr (attrName "active") else id
@@ -181,8 +186,8 @@ ui dimAttrs BrickState{ appSettings = as@BrickSettings{}, ..}
(printTool lTool) (printTool lTool)
) )
<+> minHSize 15 (str ver) <+> minHSize 15 (str ver)
<+> (let l = catMaybes . fmap printTag $ sort lTag <+> (let l = catMaybes . fmap printTag $ sort lTag'
in padLeft (Pad 1) $ minHSize 25 $ if null l in padLeft (Pad 1) $ minHSize minTagSize $ if null l
then emptyWidget then emptyWidget
else foldr1 (\x y -> x <+> str "," <+> y) l else foldr1 (\x y -> x <+> str "," <+> y) l
) )
@@ -200,6 +205,7 @@ ui dimAttrs BrickState{ appSettings = as@BrickSettings{}, ..}
printTag Prerelease = Just $ withAttr (attrName "prerelease") $ str "prerelease" printTag Prerelease = Just $ withAttr (attrName "prerelease") $ str "prerelease"
printTag (Base pvp'') = Just $ str ("base-" ++ T.unpack (prettyPVP pvp'')) printTag (Base pvp'') = Just $ str ("base-" ++ T.unpack (prettyPVP pvp''))
printTag Old = Nothing printTag Old = Nothing
printTag LatestPrerelease = Just $ withAttr (attrName "latest-prerelease") $ str "latest-prerelease"
printTag (UnknownTag t) = Just $ str t printTag (UnknownTag t) = Just $ str t
printTool Cabal = str "cabal" printTool Cabal = str "cabal"
@@ -274,6 +280,7 @@ defaultAttributes no_color = attrMap
, (attrName "recommended" , Vty.defAttr `withForeColor` Vty.green) , (attrName "recommended" , Vty.defAttr `withForeColor` Vty.green)
, (attrName "hls-powered" , Vty.defAttr `withForeColor` Vty.green) , (attrName "hls-powered" , Vty.defAttr `withForeColor` Vty.green)
, (attrName "latest" , Vty.defAttr `withForeColor` Vty.yellow) , (attrName "latest" , Vty.defAttr `withForeColor` Vty.yellow)
, (attrName "latest-prerelease" , Vty.defAttr `withForeColor` Vty.red)
, (attrName "prerelease" , Vty.defAttr `withForeColor` Vty.red) , (attrName "prerelease" , Vty.defAttr `withForeColor` Vty.red)
, (attrName "compiled" , Vty.defAttr `withForeColor` Vty.blue) , (attrName "compiled" , Vty.defAttr `withForeColor` Vty.blue)
, (attrName "stray" , Vty.defAttr `withForeColor` Vty.blue) , (attrName "stray" , Vty.defAttr `withForeColor` Vty.blue)
@@ -471,7 +478,7 @@ install' _ (_, ListResult {..}) = do
) )
>>= \case >>= \case
VRight (vi, Dirs{..}, Just ce) -> do VRight (vi, Dirs{..}, Just ce) -> do
forM_ (_viPostInstall =<< vi) $ \msg -> logInfo msg forM_ (view viPostInstall =<< vi) $ \msg -> logInfo msg
case lTool of case lTool of
GHCup -> do GHCup -> do
up <- liftIO $ fmap (either (const Nothing) Just) up <- liftIO $ fmap (either (const Nothing) Just)
@@ -483,7 +490,7 @@ install' _ (_, ListResult {..}) = do
_ -> pure () _ -> pure ()
pure $ Right () pure $ Right ()
VRight (vi, _, _) -> do VRight (vi, _, _) -> do
forM_ (_viPostInstall =<< vi) $ \msg -> logInfo msg forM_ (view viPostInstall =<< vi) $ \msg -> logInfo msg
logInfo "Please restart 'ghcup' for the changes to take effect" logInfo "Please restart 'ghcup' for the changes to take effect"
pure $ Right () pure $ Right ()
VLeft (V (AlreadyInstalled _ _)) -> pure $ Right () VLeft (V (AlreadyInstalled _ _)) -> pure $ Right ()
@@ -558,7 +565,7 @@ del' _ (_, ListResult {..}) = do
>>= \case >>= \case
VRight vi -> do VRight vi -> do
logGHCPostRm (mkTVer lVer) logGHCPostRm (mkTVer lVer)
forM_ (_viPostRemove =<< vi) $ \msg -> forM_ (view viPostRemove =<< vi) $ \msg ->
logInfo msg logInfo msg
pure $ Right () pure $ Right ()
VLeft e -> pure $ Left (prettyHFError e) VLeft e -> pure $ Left (prettyHFError e)

View File

@@ -57,6 +57,7 @@ import System.Process ( readProcess )
import System.FilePath import System.FilePath
import Text.HTML.TagSoup hiding ( Tag ) import Text.HTML.TagSoup hiding ( Tag )
import URI.ByteString import URI.ByteString
import Optics ( view )
import qualified Data.ByteString.UTF8 as UTF8 import qualified Data.ByteString.UTF8 as UTF8
import qualified Data.Map.Strict as M import qualified Data.Map.Strict as M
@@ -246,8 +247,9 @@ toolVersionTagEither s' =
tagEither :: String -> Either String Tag tagEither :: String -> Either String Tag
tagEither s' = case fmap toLower s' of tagEither s' = case fmap toLower s' of
"recommended" -> Right Recommended "recommended" -> Right Recommended
"latest" -> Right Latest "latest" -> Right Latest
"latest-prerelease" -> Right LatestPrerelease
('b':'a':'s':'e':'-':ver') -> case pvp (T.pack ver') of ('b':'a':'s':'e':'-':ver') -> case pvp (T.pack ver') of
Right x -> Right (Base x) Right x -> Right (Base x)
Left _ -> Left $ "Invalid PVP version for base " <> ver' Left _ -> Left $ "Invalid PVP version for base " <> ver'
@@ -450,9 +452,9 @@ tagCompleter tool add = listIOCompleter $ do
case mGhcUpInfo of case mGhcUpInfo of
VRight ghcupInfo -> do VRight ghcupInfo -> do
let allTags = filter (/= Old) let allTags = filter (/= Old)
$ _viTags =<< M.elems (availableToolVersions (_ghcupDownloads ghcupInfo) tool) $ (view viTags) =<< M.elems (availableToolVersions (_ghcupDownloads ghcupInfo) tool)
pure $ nub $ (add ++) $ fmap tagToString allTags pure $ nub $ (add ++) $ fmap tagToString allTags
VLeft _ -> pure (nub $ ["recommended", "latest"] ++ add) VLeft _ -> pure (nub $ ["recommended", "latest", "latest-prerelease"] ++ add)
versionCompleter :: Maybe ListCriteria -> Tool -> Completer versionCompleter :: Maybe ListCriteria -> Tool -> Completer
versionCompleter criteria tool = versionCompleter' criteria tool (const True) versionCompleter criteria tool = versionCompleter' criteria tool (const True)
@@ -706,6 +708,9 @@ fromVersion' (SetToolVersion v) tool = do
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 mkTVer Just <$> getLatest dls tool ?? TagNotFound Latest tool
fromVersion' (SetToolTag LatestPrerelease) tool = do
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
bimap mkTVer Just <$> getLatestPrerelease dls tool ?? TagNotFound LatestPrerelease 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 mkTVer Just <$> getRecommended dls tool ?? TagNotFound Recommended tool

View File

@@ -16,11 +16,11 @@ import qualified GHCup.GHC as GHC
import qualified GHCup.HLS as HLS import qualified GHCup.HLS as HLS
import GHCup.Errors import GHCup.Errors
import GHCup.Types import GHCup.Types
import GHCup.Types.Optics
import GHCup.Utils import GHCup.Utils
import GHCup.Prelude.Logger import GHCup.Prelude.Logger
import GHCup.Prelude.String.QQ import GHCup.Prelude.String.QQ
import GHCup.OptParse.Common import GHCup.OptParse.Common
import GHCup.Types.Optics
#if !MIN_VERSION_base(4,13,0) #if !MIN_VERSION_base(4,13,0)
import Control.Monad.Fail ( MonadFail ) import Control.Monad.Fail ( MonadFail )
@@ -36,6 +36,7 @@ import Data.Versions ( Version, prettyVer, version, p
import qualified Data.Versions as V import qualified Data.Versions as V
import Data.Text ( Text ) import Data.Text ( Text )
import Haskus.Utils.Variant.Excepts import Haskus.Utils.Variant.Excepts
import Optics
import Options.Applicative hiding ( style ) import Options.Applicative hiding ( style )
import Options.Applicative.Help.Pretty ( text ) import Options.Applicative.Help.Pretty ( text )
import Prelude hiding ( appendFile ) import Prelude hiding ( appendFile )
@@ -511,7 +512,7 @@ compile compileCommand settings Dirs{..} runAppState runLogger = do
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 targetVer HLS dls
forM_ (_viPreCompile =<< vi) $ \msg -> do forM_ (view viPreCompile =<< vi) $ \msg -> do
lift $ logInfo msg lift $ logInfo msg
lift $ logInfo lift $ logInfo
"...waiting for 5 seconds, you can still abort..." "...waiting for 5 seconds, you can still abort..."
@@ -539,7 +540,7 @@ compile compileCommand settings Dirs{..} runAppState runLogger = do
VRight (vi, tv) -> do VRight (vi, tv) -> do
runLogger $ logInfo runLogger $ logInfo
"HLS successfully compiled and installed" "HLS successfully compiled and installed"
forM_ (_viPostInstall =<< vi) $ \msg -> forM_ (view viPostInstall =<< vi) $ \msg ->
runLogger $ logInfo msg runLogger $ logInfo msg
liftIO $ putStr (T.unpack $ prettyVer tv) liftIO $ putStr (T.unpack $ prettyVer tv)
pure ExitSuccess pure ExitSuccess
@@ -563,7 +564,7 @@ compile compileCommand settings Dirs{..} runAppState runLogger = do
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 targetVer GHC dls
forM_ (_viPreCompile =<< vi) $ \msg -> do forM_ (view viPreCompile =<< vi) $ \msg -> do
lift $ logInfo msg lift $ logInfo msg
lift $ logInfo lift $ logInfo
"...waiting for 5 seconds, you can still abort..." "...waiting for 5 seconds, you can still abort..."
@@ -593,7 +594,7 @@ compile compileCommand settings Dirs{..} runAppState runLogger = do
VRight (vi, tv) -> do VRight (vi, tv) -> do
runLogger $ logInfo runLogger $ logInfo
"GHC successfully compiled and installed" "GHC successfully compiled and installed"
forM_ (_viPostInstall =<< vi) $ \msg -> forM_ (view viPostInstall =<< vi) $ \msg ->
runLogger $ logInfo msg runLogger $ logInfo msg
liftIO $ putStr (T.unpack $ tVerToText tv) liftIO $ putStr (T.unpack $ tVerToText tv)
pure ExitSuccess pure ExitSuccess

View File

@@ -23,6 +23,7 @@ import GHCup.Utils.Dirs
import GHCup.Prelude import GHCup.Prelude
import GHCup.Prelude.Logger import GHCup.Prelude.Logger
import GHCup.Prelude.String.QQ import GHCup.Prelude.String.QQ
import GHCup.Types.Optics
import Codec.Archive import Codec.Archive
#if !MIN_VERSION_base(4,13,0) #if !MIN_VERSION_base(4,13,0)
@@ -36,6 +37,7 @@ import Data.Maybe
import Haskus.Utils.Variant.Excepts import Haskus.Utils.Variant.Excepts
import Options.Applicative hiding ( style ) import Options.Applicative hiding ( style )
import Options.Applicative.Help.Pretty ( text ) import Options.Applicative.Help.Pretty ( text )
import Optics
import Prelude hiding ( appendFile ) import Prelude hiding ( appendFile )
import System.Exit import System.Exit
import URI.ByteString hiding ( uriParser ) import URI.ByteString hiding ( uriParser )
@@ -345,7 +347,7 @@ install installCommand settings getAppState' runLogger = case installCommand of
>>= \case >>= \case
VRight vi -> do VRight vi -> do
runLogger $ logInfo "GHC installation successful" runLogger $ logInfo "GHC installation successful"
forM_ (_viPostInstall =<< vi) $ \msg -> forM_ (view viPostInstall =<< vi) $ \msg ->
runLogger $ logInfo msg runLogger $ logInfo msg
pure ExitSuccess pure ExitSuccess
@@ -413,7 +415,7 @@ install installCommand settings getAppState' runLogger = case installCommand of
>>= \case >>= \case
VRight vi -> do VRight vi -> do
runLogger $ logInfo "Cabal installation successful" runLogger $ logInfo "Cabal installation successful"
forM_ (_viPostInstall =<< vi) $ \msg -> forM_ (view viPostInstall =<< vi) $ \msg ->
runLogger $ logInfo msg runLogger $ logInfo msg
pure ExitSuccess pure ExitSuccess
VLeft e@(V (AlreadyInstalled _ _)) -> do VLeft e@(V (AlreadyInstalled _ _)) -> do
@@ -463,7 +465,7 @@ install installCommand settings getAppState' runLogger = case installCommand of
>>= \case >>= \case
VRight vi -> do VRight vi -> do
runLogger $ logInfo "HLS installation successful" runLogger $ logInfo "HLS installation successful"
forM_ (_viPostInstall =<< vi) $ \msg -> forM_ (view viPostInstall =<< vi) $ \msg ->
runLogger $ logInfo msg runLogger $ logInfo msg
pure ExitSuccess pure ExitSuccess
VLeft e@(V (AlreadyInstalled _ _)) -> do VLeft e@(V (AlreadyInstalled _ _)) -> do
@@ -512,7 +514,7 @@ install installCommand settings getAppState' runLogger = case installCommand of
>>= \case >>= \case
VRight vi -> do VRight vi -> do
runLogger $ logInfo "Stack installation successful" runLogger $ logInfo "Stack installation successful"
forM_ (_viPostInstall =<< vi) $ \msg -> forM_ (view viPostInstall =<< vi) $ \msg ->
runLogger $ logInfo msg runLogger $ logInfo msg
pure ExitSuccess pure ExitSuccess
VLeft e@(V (AlreadyInstalled _ _)) -> do VLeft e@(V (AlreadyInstalled _ _)) -> do

View File

@@ -107,6 +107,7 @@ printListResult no_color raw lr = do
printTag Prerelease = color Red "prerelease" printTag Prerelease = color Red "prerelease"
printTag (Base pvp'') = "base-" ++ T.unpack (prettyPVP pvp'') printTag (Base pvp'') = "base-" ++ T.unpack (prettyPVP pvp'')
printTag (UnknownTag t ) = t printTag (UnknownTag t ) = t
printTag LatestPrerelease = color Red "latest-prerelease"
printTag Old = "" printTag Old = ""
let let

View File

@@ -3,7 +3,6 @@
{-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeApplications #-}
{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE RankNTypes #-} {-# LANGUAGE RankNTypes #-}
@@ -34,6 +33,7 @@ import Haskus.Utils.Variant.Excepts
import Options.Applicative hiding ( style ) import Options.Applicative hiding ( style )
import Prelude hiding ( appendFile ) import Prelude hiding ( appendFile )
import System.Exit import System.Exit
import Optics
import qualified Data.Text as T import qualified Data.Text as T
import Control.Exception.Safe (MonadMask) import Control.Exception.Safe (MonadMask)
@@ -227,5 +227,5 @@ rm rmCommand runAppState runLogger = case rmCommand of
pure $ ExitFailure 15 pure $ ExitFailure 15
postRmLog vi = postRmLog vi =
forM_ (_viPostRemove =<< vi) $ \msg -> forM_ (view viPostRemove =<< vi) $ \msg ->
runLogger $ logInfo msg runLogger $ logInfo msg

View File

@@ -28,6 +28,7 @@ import Haskus.Utils.Variant.Excepts
import Options.Applicative hiding ( style ) import Options.Applicative hiding ( style )
import Prelude hiding ( appendFile ) import Prelude hiding ( appendFile )
import System.Exit import System.Exit
import Optics ( view )
import qualified Data.Text as T import qualified Data.Text as T
import Control.Exception.Safe (MonadMask) import Control.Exception.Safe (MonadMask)
@@ -144,7 +145,7 @@ upgrade uOpts force' fatal Dirs{..} runAppState runLogger = do
let vi = fromJust $ snd <$> getLatest dls GHCup let vi = fromJust $ snd <$> getLatest dls GHCup
runLogger $ logInfo $ runLogger $ logInfo $
"Successfully upgraded GHCup to version " <> pretty_v "Successfully upgraded GHCup to version " <> pretty_v
forM_ (_viPostInstall vi) $ \msg -> forM_ (view viPostInstall vi) $ \msg ->
runLogger $ logInfo msg runLogger $ logInfo msg
pure ExitSuccess pure ExitSuccess
VLeft (V NoUpdate) -> do VLeft (V NoUpdate) -> do

View File

@@ -9,7 +9,7 @@ constraints: http-io-streams -brotli,
any.aeson >= 2.0.1.0 any.aeson >= 2.0.1.0
package libarchive package libarchive
flags: -system-libarchive flags: +system-libarchive
package aeson-pretty package aeson-pretty
flags: +lib-only flags: +lib-only

View File

@@ -0,0 +1,61 @@
FROM arm32v7/debian:10
ENV LANG C.UTF-8
ENV DEBIAN_FRONTEND=noninteractive
ENV TZ=Asia/Singapore
COPY update_opt.sh /usr/bin/update_opt.sh
RUN chmod +x /usr/bin/update_opt.sh
RUN apt-get update && \
apt-get install -y --no-install-recommends \
ca-certificates \
curl \
dirmngr \
g++ \
git \
gnupg \
libsqlite3-dev \
libtinfo-dev \
libgmp-dev \
make \
netbase \
openssh-client \
xz-utils \
zlib1g-dev \
libnuma-dev libgmp10 libssl-dev liblzma-dev libbz2-dev wget lsb-release software-properties-common apt-transport-https gcc autoconf automake build-essential gzip patchelf tree \
llvm-11 clang-11 && \
rm -rf /var/lib/apt/lists/*
RUN update_opt.sh 11 1
ARG GHCUP_VERSION=0.1.17.8
ARG GPG_KEY=7784930957807690A66EBDBE3786C5262ECB4A3F
# install ghcup
RUN gpg --batch --keyserver keys.openpgp.org --recv-keys $GPG_KEY && \
curl -sSfL -O https://downloads.haskell.org/~ghcup/$GHCUP_VERSION/armv7-linux-ghcup-$GHCUP_VERSION && \
curl -sSfL -O https://downloads.haskell.org/~ghcup/$GHCUP_VERSION/SHA256SUMS && \
curl -sSfL -O https://downloads.haskell.org/~ghcup/$GHCUP_VERSION/SHA256SUMS.sig && \
gpg --verify SHA256SUMS.sig SHA256SUMS && \
sha256sum -c --ignore-missing SHA256SUMS && \
mv armv7-linux-ghcup-$GHCUP_VERSION /usr/bin/ghcup && \
chmod +x /usr/bin/ghcup && \
rm -rf SHA256SUMS SHA256SUMS.sig
ARG GHC=8.10.7
ARG CABAL_INSTALL=3.6.2.0
ARG STACK=2.9.1
ENV GHCUP_CURL_OPTS="--silent"
ENV NO_COLOR=1
# install haskell toolchain
RUN ghcup config set gpg-setting GPGStrict && \
ghcup --verbose install ghc --isolate=/usr --force ${GHC} && \
ghcup --verbose install cabal --isolate=/usr/bin --force ${CABAL_INSTALL} && \
ghcup gc -s -c -t
ENV PATH /root/.cabal/bin:/root/.ghcup/bin:/root/.local/bin:$PATH
CMD ["ghci"]

View File

@@ -54,10 +54,7 @@ ENV NO_COLOR=1
RUN ghcup config set gpg-setting GPGStrict && \ RUN ghcup config set gpg-setting GPGStrict && \
ghcup --verbose install ghc --isolate=/usr --force ${GHC} && \ ghcup --verbose install ghc --isolate=/usr --force ${GHC} && \
ghcup --verbose install cabal --isolate=/usr/bin --force ${CABAL_INSTALL} && \ ghcup --verbose install cabal --isolate=/usr/bin --force ${CABAL_INSTALL} && \
find "/usr/lib/ghc-${GHC}/" \( -name "*_p.a" -o -name "*.p_hi" \) -type f -delete && \ ghcup gc -s -c -t
rm -r "/usr/share/doc/ghc-${GHC}" && \
rm -rf /tmp/ghcup* && \
ghcup gc -p -s -c -t
ENV PATH /root/.cabal/bin:/root/.ghcup/bin:/root/.local/bin:$PATH ENV PATH /root/.cabal/bin:/root/.ghcup/bin:/root/.local/bin:$PATH

View File

@@ -0,0 +1,61 @@
FROM arm64v8/debian:10
ENV LANG C.UTF-8
ENV DEBIAN_FRONTEND=noninteractive
ENV TZ=Asia/Singapore
COPY update_opt.sh /usr/bin/update_opt.sh
RUN chmod +x /usr/bin/update_opt.sh
RUN apt-get update && \
apt-get install -y --no-install-recommends \
ca-certificates \
curl \
dirmngr \
g++ \
git \
gnupg \
libsqlite3-dev \
libtinfo-dev \
libgmp-dev \
make \
netbase \
openssh-client \
xz-utils \
zlib1g-dev \
libnuma-dev libgmp10 libssl-dev liblzma-dev libbz2-dev wget lsb-release software-properties-common apt-transport-https gcc autoconf automake build-essential gzip patchelf tree \
llvm-11 clang-11 && \
rm -rf /var/lib/apt/lists/*
RUN update_opt.sh 11 1
ARG GHCUP_VERSION=0.1.18.0
ARG GPG_KEY=7784930957807690A66EBDBE3786C5262ECB4A3F
# install ghcup
RUN gpg --batch --keyserver keys.openpgp.org --recv-keys $GPG_KEY && \
curl -sSfL -O https://downloads.haskell.org/~ghcup/$GHCUP_VERSION/aarch64-linux-ghcup-$GHCUP_VERSION && \
curl -sSfL -O https://downloads.haskell.org/~ghcup/$GHCUP_VERSION/SHA256SUMS && \
curl -sSfL -O https://downloads.haskell.org/~ghcup/$GHCUP_VERSION/SHA256SUMS.sig && \
gpg --verify SHA256SUMS.sig SHA256SUMS && \
sha256sum -c --ignore-missing SHA256SUMS && \
mv aarch64-linux-ghcup-$GHCUP_VERSION /usr/bin/ghcup && \
chmod +x /usr/bin/ghcup && \
rm -rf SHA256SUMS SHA256SUMS.sig
ARG GHC=8.10.7
ARG CABAL_INSTALL=3.6.2.0
ARG STACK=2.9.1
ENV GHCUP_CURL_OPTS="--silent"
ENV NO_COLOR=1
# install haskell toolchain
RUN ghcup config set gpg-setting GPGStrict && \
ghcup --verbose install ghc --isolate=/usr --force ${GHC} && \
ghcup --verbose install cabal --isolate=/usr/bin --force ${CABAL_INSTALL} && \
ghcup gc -s -c -t
ENV PATH /root/.cabal/bin:/root/.ghcup/bin:/root/.local/bin:$PATH
CMD ["ghci"]

View File

@@ -0,0 +1,36 @@
#!/bin/bash
# update_alternatives.sh
update_alternatives() {
local version=${1}
local priority=${2}
local master=${3}
local slaves=${4}
local path=${5}
local cmdln
cmdln="--verbose --install ${path}${master} ${master} ${path}${master}-${version} ${priority}"
for slave in ${slaves}; do
cmdln="${cmdln} --slave ${path}${slave} ${slave} ${path}${slave}-${version}"
done
update-alternatives ${cmdln}
}
if [[ ${#} -ne 2 ]]; then
echo usage: "${0}" clang_version priority
exit 1
fi
version=${1}
priority=${2}
path="/usr/bin/"
master="llvm-config"
slaves="llvm-addr2line llvm-ar llvm-as llvm-bcanalyzer llvm-bitcode-strip llvm-cat llvm-cfi-verify llvm-cov llvm-c-test llvm-cvtres llvm-cxxdump llvm-cxxfilt llvm-cxxmap llvm-debuginfod llvm-debuginfod-find llvm-diff llvm-dis llvm-dlltool llvm-dwarfdump llvm-dwarfutil llvm-dwp llvm-exegesis llvm-extract llvm-gsymutil llvm-ifs llvm-install-name-tool llvm-jitlink llvm-jitlink-executor llvm-lib llvm-libtool-darwin llvm-link llvm-lipo llvm-lto llvm-lto2 llvm-mc llvm-mca llvm-ml llvm-modextract llvm-mt llvm-nm llvm-objcopy llvm-objdump llvm-omp-device-info llvm-opt-report llvm-otool llvm-pdbutil llvm-PerfectShuffle llvm-profdata llvm-profgen llvm-ranlib llvm-rc llvm-readelf llvm-readobj llvm-reduce llvm-remark-size-diff llvm-rtdyld llvm-sim llvm-size llvm-split llvm-stress llvm-strings llvm-strip llvm-symbolizer llvm-tapi-diff llvm-tblgen llvm-tli-checker llvm-undname llvm-windres llvm-xray"
update_alternatives "${version}" "${priority}" "${master}" "${slaves}" "${path}"
master="clang"
slaves="analyze-build asan_symbolize bugpoint c-index-test clang++ clang-apply-replacements clang-change-namespace clang-check clang-cl clang-cpp clangd clang-doc clang-extdef-mapping clang-format clang-format-diff clang-include-fixer clang-linker-wrapper clang-move clang-nvlink-wrapper clang-offload-bundler clang-offload-packager clang-offload-wrapper clang-pseudo clang-query clang-refactor clang-rename clang-reorder-fields clang-repl clang-scan-deps clang-tidy count diagtool dsymutil FileCheck find-all-symbols git-clang-format hmaptool hwasan_symbolize intercept-build ld64.lld ld.lld llc lld lldb lldb-argdumper lldb-instr lldb-server lldb-vscode lld-link lli lli-child-target modularize not obj2yaml opt pp-trace run-clang-tidy sancov sanstats scan-build scan-build-py scan-view split-file UnicodeNameMappingGenerator verify-uselistorder wasm-ld yaml2obj yaml-bench"
update_alternatives "${version}" "${priority}" "${master}" "${slaves}" "${path}"

View File

@@ -54,10 +54,7 @@ ENV NO_COLOR=1
RUN ghcup config set gpg-setting GPGStrict && \ RUN ghcup config set gpg-setting GPGStrict && \
ghcup --verbose install ghc --isolate=/usr --force ${GHC} && \ ghcup --verbose install ghc --isolate=/usr --force ${GHC} && \
ghcup --verbose install cabal --isolate=/usr/bin --force ${CABAL_INSTALL} && \ ghcup --verbose install cabal --isolate=/usr/bin --force ${CABAL_INSTALL} && \
find "/usr/lib/ghc-${GHC}/" \( -name "*_p.a" -o -name "*.p_hi" \) -type f -delete && \ ghcup gc -s -c -t
rm -r "/usr/share/doc/ghc-${GHC}" && \
rm -rf /tmp/ghcup* && \
ghcup gc -p -s -c -t
ENV PATH /root/.cabal/bin:/root/.ghcup/bin:/root/.local/bin:$PATH ENV PATH /root/.cabal/bin:/root/.ghcup/bin:/root/.local/bin:$PATH

View File

@@ -0,0 +1,36 @@
#!/bin/bash
# update_alternatives.sh
update_alternatives() {
local version=${1}
local priority=${2}
local master=${3}
local slaves=${4}
local path=${5}
local cmdln
cmdln="--verbose --install ${path}${master} ${master} ${path}${master}-${version} ${priority}"
for slave in ${slaves}; do
cmdln="${cmdln} --slave ${path}${slave} ${slave} ${path}${slave}-${version}"
done
update-alternatives ${cmdln}
}
if [[ ${#} -ne 2 ]]; then
echo usage: "${0}" clang_version priority
exit 1
fi
version=${1}
priority=${2}
path="/usr/bin/"
master="llvm-config"
slaves="llvm-addr2line llvm-ar llvm-as llvm-bcanalyzer llvm-bitcode-strip llvm-cat llvm-cfi-verify llvm-cov llvm-c-test llvm-cvtres llvm-cxxdump llvm-cxxfilt llvm-cxxmap llvm-debuginfod llvm-debuginfod-find llvm-diff llvm-dis llvm-dlltool llvm-dwarfdump llvm-dwarfutil llvm-dwp llvm-exegesis llvm-extract llvm-gsymutil llvm-ifs llvm-install-name-tool llvm-jitlink llvm-jitlink-executor llvm-lib llvm-libtool-darwin llvm-link llvm-lipo llvm-lto llvm-lto2 llvm-mc llvm-mca llvm-ml llvm-modextract llvm-mt llvm-nm llvm-objcopy llvm-objdump llvm-omp-device-info llvm-opt-report llvm-otool llvm-pdbutil llvm-PerfectShuffle llvm-profdata llvm-profgen llvm-ranlib llvm-rc llvm-readelf llvm-readobj llvm-reduce llvm-remark-size-diff llvm-rtdyld llvm-sim llvm-size llvm-split llvm-stress llvm-strings llvm-strip llvm-symbolizer llvm-tapi-diff llvm-tblgen llvm-tli-checker llvm-undname llvm-windres llvm-xray"
update_alternatives "${version}" "${priority}" "${master}" "${slaves}" "${path}"
master="clang"
slaves="analyze-build asan_symbolize bugpoint c-index-test clang++ clang-apply-replacements clang-change-namespace clang-check clang-cl clang-cpp clangd clang-doc clang-extdef-mapping clang-format clang-format-diff clang-include-fixer clang-linker-wrapper clang-move clang-nvlink-wrapper clang-offload-bundler clang-offload-packager clang-offload-wrapper clang-pseudo clang-query clang-refactor clang-rename clang-reorder-fields clang-repl clang-scan-deps clang-tidy count diagtool dsymutil FileCheck find-all-symbols git-clang-format hmaptool hwasan_symbolize intercept-build ld64.lld ld.lld llc lld lldb lldb-argdumper lldb-instr lldb-server lldb-vscode lld-link lli lli-child-target modularize not obj2yaml opt pp-trace run-clang-tidy sancov sanstats scan-build scan-build-py scan-view split-file UnicodeNameMappingGenerator verify-uselistorder wasm-ld yaml2obj yaml-bench"
update_alternatives "${version}" "${priority}" "${master}" "${slaves}" "${path}"

View File

@@ -163,6 +163,7 @@ ghcup --url-source=https://some-url/ghcup-0.0.6.yaml list
#### Known mirrors #### Known mirrors
1. [https://mirror.sjtu.edu.cn/docs/ghcup](https://mirror.sjtu.edu.cn/docs/ghcup) 1. [https://mirror.sjtu.edu.cn/docs/ghcup](https://mirror.sjtu.edu.cn/docs/ghcup)
2. [https://mirrors.ustc.edu.cn/help/ghcup.html](https://mirrors.ustc.edu.cn/help/ghcup.html)
### (Pre-)Release channels ### (Pre-)Release channels

View File

@@ -1,6 +1,6 @@
cabal-version: 2.4 cabal-version: 2.4
name: ghcup name: ghcup
version: 0.1.19.0 version: 0.1.19.2
license: LGPL-3.0-only license: LGPL-3.0-only
license-file: LICENSE license-file: LICENSE
copyright: Julian Ospald 2020 copyright: Julian Ospald 2020
@@ -258,6 +258,7 @@ executable ghcup
, libarchive ^>=3.0.3.0 , libarchive ^>=3.0.3.0
, megaparsec >=8.0.0 && <9.3 , megaparsec >=8.0.0 && <9.3
, mtl ^>=2.2 , mtl ^>=2.2
, optics ^>=0.4
, optparse-applicative >=0.15.1.0 && <0.18 , optparse-applicative >=0.15.1.0 && <0.18
, pretty ^>=1.1.3.1 , pretty ^>=1.1.3.1
, pretty-terminal ^>=0.1.0.0 , pretty-terminal ^>=0.1.0.0

View File

@@ -177,7 +177,7 @@ installCabalBin :: ( MonadMask m
, MonadUnliftIO m , MonadUnliftIO m
, MonadFail m , MonadFail m
) )
=> Version => VersionRev
-> InstallDir -> InstallDir
-> Bool -- force install -> Bool -- force install
-> Excepts -> Excepts
@@ -198,7 +198,7 @@ installCabalBin :: ( MonadMask m
() ()
installCabalBin ver installDir forceInstall = do installCabalBin ver installDir forceInstall = do
dlinfo <- liftE $ getDownloadInfo Cabal ver dlinfo <- liftE $ getDownloadInfo Cabal ver
installCabalBindist dlinfo ver installDir forceInstall installCabalBindist dlinfo (vVersion ver) installDir forceInstall
----------------- -----------------

View File

@@ -277,19 +277,19 @@ getDownloadInfo :: ( MonadReader env m
, HasGHCupInfo env , HasGHCupInfo env
) )
=> Tool => Tool
-> Version -> VersionRev
-- ^ tool version -- ^ tool version
-> Excepts -> Excepts
'[NoDownload] '[NoDownload]
m m
DownloadInfo DownloadInfo
getDownloadInfo t v = do getDownloadInfo t (VersionRev v vr) = do
(PlatformRequest a p mv) <- lift getPlatformReq (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 =
let platformVersionSpec = let platformVersionSpec =
preview (ix t % ix v % viArch % ix a % ix (f p)) dls preview (ix t % ix v % viDownload % ix vr % viArch % ix a % ix (f p)) dls
mv' = g mv mv' = g mv
in fmap snd in fmap snd
. find . find

View File

@@ -78,6 +78,7 @@ import qualified Data.Text as T
import qualified Data.Text.IO as T import qualified Data.Text.IO as T
import qualified Data.Text.Encoding as E import qualified Data.Text.Encoding as E
import qualified Text.Megaparsec as MP import qualified Text.Megaparsec as MP
import qualified Data.Map.Strict as M
data GHCVer v = SourceDist v data GHCVer v = SourceDist v
@@ -105,7 +106,7 @@ testGHCVer :: ( MonadFail m
, MonadIO m , MonadIO m
, MonadUnliftIO m , MonadUnliftIO m
) )
=> Version => VersionRev
-> [T.Text] -> [T.Text]
-> Excepts -> Excepts
'[ DigestError '[ DigestError
@@ -120,11 +121,11 @@ testGHCVer :: ( MonadFail m
] ]
m m
() ()
testGHCVer ver addMakeArgs = do testGHCVer (VersionRev ver vr) addMakeArgs = do
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
dlInfo <- dlInfo <-
preview (ix GHC % ix ver % viTestDL % _Just) dls preview (ix GHC % ix ver % viDownload % to M.toAscList % maybe _last ix vr % to snd % viTestDL % _Just) dls
?? NoDownload ?? NoDownload
liftE $ testGHCBindist dlInfo ver addMakeArgs liftE $ testGHCBindist dlInfo ver addMakeArgs
@@ -243,7 +244,7 @@ fetchGHCSrc :: ( MonadFail m
, MonadIO m , MonadIO m
, MonadUnliftIO m , MonadUnliftIO m
) )
=> Version => VersionRev
-> Maybe FilePath -> Maybe FilePath
-> Excepts -> Excepts
'[ DigestError '[ DigestError
@@ -254,10 +255,10 @@ fetchGHCSrc :: ( MonadFail m
] ]
m m
FilePath FilePath
fetchGHCSrc v mfp = do fetchGHCSrc (VersionRev v vr) 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 % viDownload % to M.toAscList % maybe _last ix vr % to snd % viSourceDL % _Just) dls
?? NoDownload ?? NoDownload
liftE $ downloadCached' dlInfo Nothing mfp liftE $ downloadCached' dlInfo Nothing mfp
@@ -804,7 +805,7 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patches aargs buildFlavour hadr
-- download source tarball -- download source tarball
dlInfo <- dlInfo <-
preview (ix GHC % ix (tver ^. tvVersion) % viSourceDL % _Just) dls preview (ix GHC % ix (tver ^. tvVersion) % viDownload % _last % viSourceDL % _Just) dls
?? NoDownload ?? NoDownload
dl <- liftE $ downloadCached dlInfo Nothing dl <- liftE $ downloadCached dlInfo Nothing

View File

@@ -368,7 +368,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 tver % viDownload % _last % viSourceDL % _Just) dls
?? NoDownload ?? NoDownload
dl <- liftE $ downloadCached dlInfo Nothing dl <- liftE $ downloadCached dlInfo Nothing

View File

@@ -308,7 +308,7 @@ listVersions lt' criteria = do
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 = currentVer
, lTag = maybe (if isOld then [Old] else []) _viTags listVer , lTag = maybe (if isOld then [Old] else []) (view viTags) listVer
, lCross = Nothing , lCross = Nothing
, lTool = GHCup , lTool = GHCup
, fromSrc = False , fromSrc = False
@@ -337,7 +337,8 @@ listVersions lt' criteria = do
-> [Either FilePath Version] -> [Either FilePath Version]
-> (Version, VersionInfo) -> (Version, VersionInfo)
-> m ListResult -> m ListResult
toListResult t cSet cabals hlsSet' hlses stackSet' stacks (v, _viTags -> tags) = do toListResult t cSet cabals hlsSet' hlses stackSet' stacks (v, vi) = do
let tags = view viTags vi
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 v

View File

@@ -124,7 +124,6 @@ readDirEntPortable (DirStreamPortable (basedir, dirs)) = do
(DirType #{const DT_LNK}, _) -> pure (dt, fp) (DirType #{const DT_LNK}, _) -> pure (dt, fp)
(DirType #{const DT_REG}, _) -> pure (dt, fp) (DirType #{const DT_REG}, _) -> pure (dt, fp)
(DirType #{const DT_SOCK}, _) -> pure (dt, fp) (DirType #{const DT_SOCK}, _) -> pure (dt, fp)
(DirType #{const DT_UNKNOWN}, _) -> pure (dt, fp)
(_, _) (_, _)
| fp /= "" -> do | fp /= "" -> do
stat <- getSymbolicLinkStatus (basedir </> fp) stat <- getSymbolicLinkStatus (basedir </> fp)
@@ -136,4 +135,5 @@ readDirEntPortable (DirStreamPortable (basedir, dirs)) = do
| isRegularFile stat -> DirType #{const DT_REG} | isRegularFile stat -> DirType #{const DT_REG}
| isSocket stat -> DirType #{const DT_SOCK} | isSocket stat -> DirType #{const DT_SOCK}
| otherwise -> DirType #{const DT_UNKNOWN} | otherwise -> DirType #{const DT_UNKNOWN}
| otherwise -> pure (dt, fp)

View File

@@ -28,6 +28,8 @@ import System.FilePath
import qualified Data.List.NonEmpty as NE import qualified Data.List.NonEmpty as NE
import qualified Data.Text as T import qualified Data.Text as T
import qualified Text.Megaparsec as MP import qualified Text.Megaparsec as MP
import Data.Char (digitToInt)
import Data.Data (Proxy(..))
choice' :: (MonadFail f, MP.MonadParsec e s f) => [f a] -> f a choice' :: (MonadFail f, MP.MonadParsec e s f) => [f a] -> f a
@@ -86,7 +88,33 @@ ghcTargetVerP =
<$> (MP.try (Just <$> parseUntil1 (MP.chunk "-" *> verP') <* MP.chunk "-") <$> (MP.try (Just <$> parseUntil1 (MP.chunk "-" *> verP') <* MP.chunk "-")
<|> ((\ _ x -> x) Nothing <$> mempty) <|> ((\ _ x -> x) Nothing <$> mempty)
) )
<*> (version' <* MP.eof) <*> version'
where
verP' :: MP.Parsec Void Text Text
verP' = do
v <- version'
let startsWithDigists =
and
. take 3
. concatMap
(map
(\case
(Digits _) -> True
(Str _) -> False
) . NE.toList)
. NE.toList
$ _vChunks v
if startsWithDigists && isNothing (_vEpoch v)
then pure $ prettyVer v
else fail "Oh"
ghcTargetVerRevP :: MP.Parsec Void Text GHCTargetVersionRev
ghcTargetVerRevP =
(\x y -> GHCTargetVersionRev x y)
<$> (MP.try (Just <$> parseUntil1 (MP.chunk "-" *> verP') <* MP.chunk "-")
<|> ((\ _ x -> x) Nothing <$> mempty)
)
<*> versionRevP
where where
verP' :: MP.Parsec Void Text Text verP' :: MP.Parsec Void Text Text
verP' = do verP' = do
@@ -122,3 +150,44 @@ verP suffix = do
pathSep :: MP.Parsec Void Text Char pathSep :: MP.Parsec Void Text Char
pathSep = MP.oneOf pathSeparators pathSep = MP.oneOf pathSeparators
versionRevP :: MP.Parsec Void Text VersionRev
versionRevP = MP.label "versionRev" $
MP.try (parseUntil (MP.try (MP.chunk "-r")) >>= versionWithRev) <|> ((`VersionRev` 0) <$> version')
where
versionWithRev ver = do
rest <- MP.getInput
MP.setInput ver
v <- version'
MP.setInput rest
_ <- MP.chunk "-r"
rev <- parseInt
pure $ VersionRev v rev
digit = MP.oneOf ['0'..'9'] MP.<?> "digit"
parseInt :: MP.Parsec Void Text Int
parseInt = MP.label "parseInt" $ do
i <- MP.tokensToChunk (Proxy :: Proxy Text) <$> some digit
pure $ numberValue 10 $ T.unpack i
numberValue :: Int -> String -> Int
numberValue base = foldl (\ x -> ((fromIntegral base * x) +) . fromIntegral . digitToInt) 0
userVersionRevP :: MP.Parsec Void Text UserVersionRev
userVersionRevP = MP.label "userVersionRev" $
((\(VersionRev v r) -> UserVersionRev v (Just r)) <$> MP.try versionRevP) <|> ((`UserVersionRev` Nothing) <$> version')
-- | Read a @VersionRev@ from a String.
--
-- - 3.3.2 -> VersionRev { vVersion = 3.3.3, vRev = 0 }
-- - 2.3.4-r3 -> VersionRev { vVersion = 2.3.4, vRev = 3 }
versionRev :: Text -> Either (MP.ParseErrorBundle Text Void) VersionRev
versionRev = MP.parse versionRevP ""
-- | Read a @UserVersionRev@ from a String.
--
-- - 3.3.2 -> UserVersionRev { vVersion = 3.3.3, vRev = Nothing }
-- - 2.3.4-r3 -> UserVersionRev { vVersion = 2.3.4, vRev = Just 3 }
userVersionRev :: Text -> Either (MP.ParseErrorBundle Text Void) UserVersionRev
userVersionRev = MP.parse userVersionRevP ""

View File

@@ -44,6 +44,8 @@ import Graphics.Vty ( Key(..) )
import qualified Data.ByteString.Lazy as BL import qualified Data.ByteString.Lazy as BL
import qualified Data.Text as T import qualified Data.Text as T
import qualified GHC.Generics as GHC import qualified GHC.Generics as GHC
import qualified Data.Map.Strict as M
#if !defined(BRICK) #if !defined(BRICK)
@@ -135,6 +137,19 @@ instance NFData GlobalTool
-- | 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.
data VersionInfo = VersionInfo data VersionInfo = VersionInfo
{ _viTags :: [Tag] -- ^ version specific tag
, _viChangeLog :: Maybe URI
, _viDownload :: Map Int VersionDownload
-- informative messages
, _viPostInstall :: Maybe Text
, _viPostRemove :: Maybe Text
, _viPreCompile :: Maybe Text
}
deriving (Eq, GHC.Generic, Show)
instance NFData VersionInfo
data VersionInfoLegacy = VersionInfoLegacy
{ _viTags :: [Tag] -- ^ version specific tag { _viTags :: [Tag] -- ^ version specific tag
, _viChangeLog :: Maybe URI , _viChangeLog :: Maybe URI
, _viSourceDL :: Maybe DownloadInfo -- ^ source tarball , _viSourceDL :: Maybe DownloadInfo -- ^ source tarball
@@ -147,13 +162,54 @@ data VersionInfo = VersionInfo
} }
deriving (Eq, GHC.Generic, Show) deriving (Eq, GHC.Generic, Show)
instance NFData VersionInfo data VersionDownload = VersionDownload
{ _viSourceDL :: Maybe DownloadInfo -- ^ source tarball
, _viTestDL :: Maybe DownloadInfo -- ^ test tarball
, _viArch :: ArchitectureSpec -- ^ descend for binary downloads per arch
}
deriving (Eq, GHC.Generic, Show)
instance NFData VersionDownload
fromVersionInfoLegacy :: VersionInfoLegacy -> VersionInfo
fromVersionInfoLegacy VersionInfoLegacy{..} =
VersionInfo {_viDownload = M.singleton 0 $ VersionDownload { _viSourceDL = _viSourceDL
, _viTestDL = _viTestDL
, _viArch = _viArch
}
, ..}
-- | A version with a revision, denoting bindist 'versions' that are purely distribution specific.
--
-- The revision starts at 0.
data VersionRev = VersionRev { vVersion :: Version, vRev :: Int }
deriving (Ord, Eq, GHC.Generic, Show)
showVersionRev :: VersionRev -> Text
showVersionRev (VersionRev v 0) = prettyVer v
showVersionRev (VersionRev v r) = prettyVer v <> "-r" <> T.pack (show r)
-- | Similar to @VersionRev@, except that revision is optional. The absence of a revision has
-- a particular meaning:
--
-- * for install/prefetch: we want the latest available revision
-- * for compile: it depends
-- * for rm/set/unset/whereis/changelog: we want the revision that is installed (there can be only one)
--
-- Translating @UserVersionRev@ to @VersionRev@ requires context of the GHCup metadata,
-- installed versions and the to be executed command.
data UserVersionRev = UserVersionRev { uvVersion :: Version, uvRev :: Maybe Int }
deriving (Ord, Eq, GHC.Generic, Show)
-- | A tag. These are currently attached to a version of a tool. -- | A tag. These are currently attached to a version of a tool.
data Tag = Latest data Tag = Latest
| Recommended | Recommended
| Prerelease | Prerelease
| LatestPrerelease
| Base PVP | Base PVP
| Old -- ^ old versions are hidden by default in TUI | Old -- ^ old versions are hidden by default in TUI
| UnknownTag String -- ^ used for upwardscompat | UnknownTag String -- ^ used for upwardscompat
@@ -167,6 +223,7 @@ tagToString Latest = "latest"
tagToString Prerelease = "prerelease" tagToString Prerelease = "prerelease"
tagToString (Base pvp'') = "base-" ++ T.unpack (prettyPVP pvp'') tagToString (Base pvp'') = "base-" ++ T.unpack (prettyPVP pvp'')
tagToString (UnknownTag t ) = t tagToString (UnknownTag t ) = t
tagToString LatestPrerelease = "latest-prerelease"
tagToString Old = "" tagToString Old = ""
instance Pretty Tag where instance Pretty Tag where
@@ -175,6 +232,7 @@ instance Pretty Tag where
pPrint Prerelease = text "prerelease" pPrint Prerelease = text "prerelease"
pPrint (Base pvp'') = text ("base-" ++ T.unpack (prettyPVP pvp'')) pPrint (Base pvp'') = text ("base-" ++ T.unpack (prettyPVP pvp''))
pPrint (UnknownTag t ) = text t pPrint (UnknownTag t ) = text t
pPrint LatestPrerelease = text "latest-prerelease"
pPrint Old = mempty pPrint Old = mempty
data Architecture = A_64 data Architecture = A_64
@@ -583,12 +641,6 @@ data GHCTargetVersion = GHCTargetVersion
} }
deriving (Ord, Eq, Show) deriving (Ord, Eq, Show)
data GitBranch = GitBranch
{ ref :: String
, repo :: Maybe String
}
deriving (Ord, Eq, Show)
mkTVer :: Version -> GHCTargetVersion mkTVer :: Version -> GHCTargetVersion
mkTVer = GHCTargetVersion Nothing mkTVer = GHCTargetVersion Nothing
@@ -596,10 +648,30 @@ tVerToText :: GHCTargetVersion -> Text
tVerToText (GHCTargetVersion (Just t) v') = t <> "-" <> prettyVer v' tVerToText (GHCTargetVersion (Just t) v') = t <> "-" <> prettyVer v'
tVerToText (GHCTargetVersion Nothing v') = prettyVer v' tVerToText (GHCTargetVersion Nothing v') = prettyVer v'
-- | A GHC identified by the target platform triple
-- and the version.
data GHCTargetVersionRev = GHCTargetVersionRev
{ _tvTargetRev :: Maybe Text
, _tvVersionRev :: VersionRev
}
deriving (Ord, Eq, Show)
mkTVerRev :: VersionRev -> GHCTargetVersionRev
mkTVerRev = GHCTargetVersionRev Nothing
tVerRevToText :: GHCTargetVersionRev -> Text
tVerRevToText (GHCTargetVersionRev (Just t) v') = t <> "-" <> showVersionRev v'
tVerRevToText (GHCTargetVersionRev Nothing v') = showVersionRev v'
-- | Assembles a path of the form: <target-triple>-<version> -- | Assembles a path of the form: <target-triple>-<version>
instance Pretty GHCTargetVersion where instance Pretty GHCTargetVersion where
pPrint = text . T.unpack . tVerToText pPrint = text . T.unpack . tVerToText
data GitBranch = GitBranch
{ ref :: String
, repo :: Maybe String
}
deriving (Ord, Eq, Show)
-- | A comparator and a version. -- | A comparator and a version.
data VersionCmp = VR_gt Versioning data VersionCmp = VR_gt Versioning

View File

@@ -66,6 +66,7 @@ instance ToJSON Tag where
toJSON Prerelease = String "Prerelease" toJSON Prerelease = String "Prerelease"
toJSON Old = String "old" toJSON Old = String "old"
toJSON (Base pvp'') = String ("base-" <> prettyPVP pvp'') toJSON (Base pvp'') = String ("base-" <> prettyPVP pvp'')
toJSON LatestPrerelease = String "LatestPrerelease"
toJSON (UnknownTag x ) = String (T.pack x) toJSON (UnknownTag x ) = String (T.pack x)
instance FromJSON Tag where instance FromJSON Tag where
@@ -73,6 +74,7 @@ instance FromJSON Tag where
"Latest" -> pure Latest "Latest" -> pure Latest
"Recommended" -> pure Recommended "Recommended" -> pure Recommended
"Prerelease" -> pure Prerelease "Prerelease" -> pure Prerelease
"LatestPrerelease" -> pure LatestPrerelease
"old" -> pure Old "old" -> pure Old
('b' : 'a' : 's' : 'e' : '-' : ver') -> case pvp (T.pack ver') of ('b' : 'a' : 's' : 'e' : '-' : ver') -> case pvp (T.pack ver') of
Right x -> pure $ Base x Right x -> pure $ Base x
@@ -318,11 +320,18 @@ instance FromJSONKey (Maybe VersionRange) where
Right x -> pure $ Just x Right x -> pure $ Just x
Left e -> fail $ "Failure in (Maybe VersionRange) (FromJSONKey)" <> MP.errorBundlePretty e Left e -> fail $ "Failure in (Maybe VersionRange) (FromJSONKey)" <> MP.errorBundlePretty e
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''Requirements deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''Requirements
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''DownloadInfo deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''DownloadInfo
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''VersionInfo deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''VersionInfoLegacy
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''VersionDownload
instance FromJSON VersionInfo where
parseJSON v = parseLegacy v <|> parseNew v
where
parseLegacy = fmap fromVersionInfoLegacy . parseJSON @VersionInfoLegacy
parseNew = genericParseJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel }
deriveToJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''VersionInfo
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''GHCupInfo deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''GHCupInfo
deriveToJSON defaultOptions { sumEncoding = ObjectWithSingleField } ''URLSource deriveToJSON defaultOptions { sumEncoding = ObjectWithSingleField } ''URLSource
deriveJSON defaultOptions { sumEncoding = ObjectWithSingleField } ''Key deriveJSON defaultOptions { sumEncoding = ObjectWithSingleField } ''Key

View File

@@ -37,6 +37,7 @@ makeLenses ''PlatformResult
makeLenses ''DownloadInfo makeLenses ''DownloadInfo
makeLenses ''Tag makeLenses ''Tag
makeLenses ''VersionInfo makeLenses ''VersionInfo
makeLenses ''VersionDownload
makeLenses ''GHCTargetVersion makeLenses ''GHCTargetVersion

View File

@@ -160,7 +160,7 @@ rmMinorGHCSymlinks :: ( MonadReader env m
rmMinorGHCSymlinks tv@GHCTargetVersion{..} = do rmMinorGHCSymlinks tv@GHCTargetVersion{..} = do
Dirs {..} <- lift getDirs Dirs {..} <- lift getDirs
files <- liftE $ ghcToolFiles tv files <- liftE $ ghcToolFiles tv
forM_ files $ \f -> do forM_ files $ \f -> do
let f_xyz = f <> "-" <> T.unpack (prettyVer _tvVersion) <> exeExt let f_xyz = f <> "-" <> T.unpack (prettyVer _tvVersion) <> exeExt
let fullF = binDir </> f_xyz let fullF = binDir </> f_xyz
@@ -181,7 +181,7 @@ rmPlainGHC :: ( MonadReader env m
-> Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ()
rmPlainGHC target = do rmPlainGHC target = do
Dirs {..} <- lift getDirs Dirs {..} <- lift getDirs
mtv <- lift $ ghcSet target mtv <- lift $ ghcSet target
forM_ mtv $ \tv -> do forM_ mtv $ \tv -> do
files <- liftE $ ghcToolFiles tv files <- liftE $ ghcToolFiles tv
forM_ files $ \f -> do forM_ files $ \f -> do
@@ -228,7 +228,7 @@ rmMinorHLSSymlinks :: ( MonadReader env m
, MonadFail m , MonadFail m
, MonadMask m , MonadMask m
) )
=> Version => VersionRev
-> Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ()
rmMinorHLSSymlinks ver = do rmMinorHLSSymlinks ver = do
Dirs {..} <- lift getDirs Dirs {..} <- lift getDirs
@@ -281,7 +281,7 @@ rmPlainHLS = do
----------------------------------- -----------------------------------
-- | Whether the given GHC versin is installed. -- | Whether the given GHC version is installed.
ghcInstalled :: (MonadIO m, MonadReader env m, HasDirs env, MonadThrow m) => GHCTargetVersion -> m Bool ghcInstalled :: (MonadIO m, MonadReader env m, HasDirs env, MonadThrow m) => GHCTargetVersion -> m Bool
ghcInstalled ver = do ghcInstalled ver = do
ghcdir <- ghcupGHCDir ver ghcdir <- ghcupGHCDir ver
@@ -299,7 +299,7 @@ ghcSrcInstalled ver = do
ghcSet :: (MonadReader env m, HasDirs env, MonadThrow m, MonadIO m) ghcSet :: (MonadReader env m, HasDirs env, MonadThrow m, MonadIO m)
=> Maybe Text -- ^ the target of the GHC version, if any => Maybe Text -- ^ the target of the GHC version, if any
-- (e.g. armv7-unknown-linux-gnueabihf) -- (e.g. armv7-unknown-linux-gnueabihf)
-> m (Maybe GHCTargetVersion) -> m (Maybe GHCTargetVersionRev)
ghcSet mtarget = do ghcSet mtarget = do
Dirs {..} <- getDirs Dirs {..} <- getDirs
let ghc = maybe "ghc" (\t -> T.unpack t <> "-ghc") mtarget let ghc = maybe "ghc" (\t -> T.unpack t <> "-ghc") mtarget
@@ -311,7 +311,7 @@ ghcSet mtarget = do
link <- liftIO $ getLinkTarget ghcBin link <- liftIO $ getLinkTarget ghcBin
Just <$> ghcLinkVersion link Just <$> ghcLinkVersion link
where where
ghcLinkVersion :: MonadThrow m => FilePath -> m GHCTargetVersion ghcLinkVersion :: MonadThrow m => FilePath -> m GHCTargetVersionRev
ghcLinkVersion (T.pack . dropSuffix exeExt -> t) = throwEither $ MP.parse parser "ghcLinkVersion" t ghcLinkVersion (T.pack . dropSuffix exeExt -> t) = throwEither $ MP.parse parser "ghcLinkVersion" t
where where
parser = parser =
@@ -321,7 +321,7 @@ ghcSet mtarget = do
r <- parseUntil1 pathSep r <- parseUntil1 pathSep
rest <- MP.getInput rest <- MP.getInput
MP.setInput r MP.setInput r
x <- ghcTargetVerP x <- ghcTargetVerRevP
MP.setInput rest MP.setInput rest
pure x pure x
) )
@@ -335,7 +335,7 @@ ghcSet mtarget = do
getInstalledGHCs :: (MonadReader env m, HasDirs env, MonadIO m) => m [Either FilePath GHCTargetVersion] getInstalledGHCs :: (MonadReader env m, HasDirs env, MonadIO m) => m [Either FilePath GHCTargetVersion]
getInstalledGHCs = do getInstalledGHCs = do
ghcdir <- ghcupGHCBaseDir ghcdir <- ghcupGHCBaseDir
fs <- liftIO $ hideErrorDef [NoSuchThing] [] $ listDirectory (fromGHCupPath ghcdir) fs <- liftIO $ hideErrorDef [NoSuchThing] [] $ listDirectoryDirs (fromGHCupPath ghcdir)
forM fs $ \f -> case parseGHCupGHCDir f of forM fs $ \f -> case parseGHCupGHCDir f of
Right r -> pure $ Right r Right r -> pure $ Right r
Left _ -> pure $ Left f Left _ -> pure $ Left f
@@ -347,13 +347,13 @@ getInstalledCabals :: ( MonadReader env m
, MonadIO m , MonadIO m
, MonadCatch m , MonadCatch m
) )
=> m [Either FilePath Version] => m [Either FilePath VersionRev]
getInstalledCabals = do getInstalledCabals = do
Dirs {..} <- getDirs Dirs {..} <- getDirs
bins <- liftIO $ handleIO (\_ -> pure []) $ findFiles bins <- liftIO $ handleIO (\_ -> pure []) $ findFiles
binDir binDir
(makeRegexOpts compExtended execBlank ([s|^cabal-.*$|] :: ByteString)) (makeRegexOpts compExtended execBlank ([s|^cabal-.*$|] :: ByteString))
vs <- forM bins $ \f -> case version . T.pack <$> (stripSuffix exeExt =<< stripPrefix "cabal-" f) of vs <- forM bins $ \f -> case versionRev . T.pack <$> (stripSuffix exeExt =<< stripPrefix "cabal-" f) of
Just (Right r) -> pure $ Right r Just (Right r) -> pure $ Right r
Just (Left _) -> pure $ Left f Just (Left _) -> pure $ Left f
Nothing -> pure $ Left f Nothing -> pure $ Left f
@@ -361,14 +361,14 @@ getInstalledCabals = do
-- | Whether the given cabal version is installed. -- | Whether the given cabal version is installed.
cabalInstalled :: (MonadIO m, MonadReader env m, HasDirs env, MonadCatch m) => Version -> m Bool cabalInstalled :: (MonadIO m, MonadReader env m, HasDirs env, MonadCatch m) => VersionRev -> m Bool
cabalInstalled ver = do cabalInstalled ver = do
vers <- fmap rights getInstalledCabals vers <- fmap rights getInstalledCabals
pure $ elem ver vers pure $ elem ver vers
-- Return the currently set cabal version, if any. -- Return the currently set cabal version, if any.
cabalSet :: (HasLog env, MonadReader env m, HasDirs env, MonadIO m, MonadThrow m, MonadCatch m) => m (Maybe Version) cabalSet :: (HasLog env, MonadReader env m, HasDirs env, MonadIO m, MonadThrow m, MonadCatch m) => m (Maybe VersionRev)
cabalSet = do cabalSet = do
Dirs {..} <- getDirs Dirs {..} <- getDirs
let cabalbin = binDir </> "cabal" <> exeExt let cabalbin = binDir </> "cabal" <> exeExt
@@ -395,7 +395,7 @@ cabalSet = do
-- We try to be extra permissive with link destination parsing, -- We try to be extra permissive with link destination parsing,
-- because of: -- because of:
-- https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/119 -- https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/119
linkVersion :: MonadThrow m => FilePath -> m Version linkVersion :: MonadThrow m => FilePath -> m VersionRev
linkVersion = throwEither . MP.parse parser "linkVersion" . T.pack . dropSuffix exeExt linkVersion = throwEither . MP.parse parser "linkVersion" . T.pack . dropSuffix exeExt
parser parser
@@ -403,7 +403,7 @@ cabalSet = do
<|> MP.try (stripRelativePath *> cabalParse) <|> MP.try (stripRelativePath *> cabalParse)
<|> cabalParse <|> cabalParse
-- parses the version of "cabal-3.2.0.0" -> "3.2.0.0" -- parses the version of "cabal-3.2.0.0" -> "3.2.0.0"
cabalParse = MP.chunk "cabal-" *> version' cabalParse = MP.chunk "cabal-" *> versionRevP
-- parses any path component ending with path separator, -- parses any path component ending with path separator,
-- e.g. "foo/" -- e.g. "foo/"
stripPathComponet = parseUntil1 pathSep *> MP.some pathSep stripPathComponet = parseUntil1 pathSep *> MP.some pathSep
@@ -420,7 +420,7 @@ cabalSet = do
-- @~\/.ghcup\/bin/haskell-language-server-wrapper-<\hlsver\>@, -- @~\/.ghcup\/bin/haskell-language-server-wrapper-<\hlsver\>@,
-- as well as @~\/.ghcup\/hls\/<\hlsver\>@ -- as well as @~\/.ghcup\/hls\/<\hlsver\>@
getInstalledHLSs :: (MonadReader env m, HasDirs env, MonadIO m, MonadCatch m) getInstalledHLSs :: (MonadReader env m, HasDirs env, MonadIO m, MonadCatch m)
=> m [Either FilePath Version] => m [Either FilePath VersionRev]
getInstalledHLSs = do getInstalledHLSs = do
Dirs {..} <- getDirs Dirs {..} <- getDirs
bins <- liftIO $ handleIO (\_ -> pure []) $ findFiles bins <- liftIO $ handleIO (\_ -> pure []) $ findFiles
@@ -431,14 +431,14 @@ getInstalledHLSs = do
) )
legacy <- forM bins $ \f -> legacy <- forM bins $ \f ->
case case
version . T.pack <$> (stripSuffix exeExt =<< stripPrefix "haskell-language-server-wrapper-" f) versionRev . T.pack <$> (stripSuffix exeExt =<< stripPrefix "haskell-language-server-wrapper-" f)
of of
Just (Right r) -> pure $ Right r Just (Right r) -> pure $ Right r
Just (Left _) -> pure $ Left f Just (Left _) -> pure $ Left f
Nothing -> pure $ Left f Nothing -> pure $ Left f
hlsdir <- ghcupHLSBaseDir hlsdir <- ghcupHLSBaseDir
fs <- liftIO $ hideErrorDef [NoSuchThing] [] $ listDirectory (fromGHCupPath hlsdir) fs <- liftIO $ hideErrorDef [NoSuchThing] [] $ listDirectoryDirs (fromGHCupPath hlsdir)
new <- forM fs $ \f -> case parseGHCupHLSDir f of new <- forM fs $ \f -> case parseGHCupHLSDir f of
Right r -> pure $ Right r Right r -> pure $ Right r
Left _ -> pure $ Left f Left _ -> pure $ Left f
@@ -448,7 +448,7 @@ getInstalledHLSs = do
-- | Get all installed stacks, by matching on -- | Get all installed stacks, by matching on
-- @~\/.ghcup\/bin/stack-<\stackver\>@. -- @~\/.ghcup\/bin/stack-<\stackver\>@.
getInstalledStacks :: (MonadReader env m, HasDirs env, MonadIO m, MonadCatch m) getInstalledStacks :: (MonadReader env m, HasDirs env, MonadIO m, MonadCatch m)
=> m [Either FilePath Version] => m [Either FilePath VersionRev]
getInstalledStacks = do getInstalledStacks = do
Dirs {..} <- getDirs Dirs {..} <- getDirs
bins <- liftIO $ handleIO (\_ -> pure []) $ findFiles bins <- liftIO $ handleIO (\_ -> pure []) $ findFiles
@@ -458,7 +458,7 @@ getInstalledStacks = do
([s|^stack-.*$|] :: ByteString) ([s|^stack-.*$|] :: ByteString)
) )
forM bins $ \f -> forM bins $ \f ->
case version . T.pack <$> (stripSuffix exeExt =<< stripPrefix "stack-" f) of case versionRev . T.pack <$> (stripSuffix exeExt =<< stripPrefix "stack-" f) of
Just (Right r) -> pure $ Right r Just (Right r) -> pure $ Right r
Just (Left _) -> pure $ Left f Just (Left _) -> pure $ Left f
Nothing -> pure $ Left f Nothing -> pure $ Left f
@@ -509,13 +509,13 @@ stackSet = do
stripRelativePath = MP.many (MP.try stripPathComponet) stripRelativePath = MP.many (MP.try stripPathComponet)
-- | Whether the given Stack version is installed. -- | Whether the given Stack version is installed.
stackInstalled :: (MonadIO m, MonadReader env m, HasDirs env, MonadCatch m) => Version -> m Bool stackInstalled :: (MonadIO m, MonadReader env m, HasDirs env, MonadCatch m) => VersionRev -> m Bool
stackInstalled ver = do stackInstalled ver = do
vers <- fmap rights getInstalledStacks vers <- fmap rights getInstalledStacks
pure $ elem ver vers pure $ elem ver vers
-- | Whether the given HLS version is installed. -- | Whether the given HLS version is installed.
hlsInstalled :: (MonadIO m, MonadReader env m, HasDirs env, MonadCatch m) => Version -> m Bool hlsInstalled :: (MonadIO m, MonadReader env m, HasDirs env, MonadCatch m) => VersionRev -> m Bool
hlsInstalled ver = do hlsInstalled ver = do
vers <- fmap rights getInstalledHLSs vers <- fmap rights getInstalledHLSs
pure $ elem ver vers pure $ elem ver vers
@@ -527,7 +527,7 @@ isLegacyHLS ver = do
-- Return the currently set hls version, if any. -- Return the currently set hls version, if any.
hlsSet :: (MonadReader env m, HasDirs env, MonadIO m, MonadThrow m, MonadCatch m) => m (Maybe Version) hlsSet :: (MonadReader env m, HasDirs env, MonadIO m, MonadThrow m, MonadCatch m) => m (Maybe VersionRev)
hlsSet = do hlsSet = do
Dirs {..} <- getDirs Dirs {..} <- getDirs
let hlsBin = binDir </> "haskell-language-server-wrapper" <> exeExt let hlsBin = binDir </> "haskell-language-server-wrapper" <> exeExt
@@ -540,7 +540,7 @@ hlsSet = do
link <- liftIO $ getLinkTarget hlsBin link <- liftIO $ getLinkTarget hlsBin
Just <$> linkVersion link Just <$> linkVersion link
where where
linkVersion :: MonadThrow m => FilePath -> m Version linkVersion :: MonadThrow m => FilePath -> m VersionRev
linkVersion = throwEither . MP.parse parser "" . T.pack . dropSuffix exeExt linkVersion = throwEither . MP.parse parser "" . T.pack . dropSuffix exeExt
where where
parser parser
@@ -548,7 +548,7 @@ hlsSet = do
<|> MP.try (stripRelativePath *> cabalParse) <|> MP.try (stripRelativePath *> cabalParse)
<|> cabalParse <|> cabalParse
-- parses the version of "haskell-language-server-wrapper-1.1.0" -> "1.1.0" -- parses the version of "haskell-language-server-wrapper-1.1.0" -> "1.1.0"
cabalParse = MP.chunk "haskell-language-server-wrapper-" *> version' cabalParse = MP.chunk "haskell-language-server-wrapper-" *> versionRevP
-- parses any path component ending with path separator, -- parses any path component ending with path separator,
-- e.g. "foo/" -- e.g. "foo/"
stripPathComponet = parseUntil1 pathSep *> MP.some pathSep stripPathComponet = parseUntil1 pathSep *> MP.some pathSep
@@ -567,7 +567,7 @@ hlsGHCVersions :: ( MonadReader env m
, MonadThrow m , MonadThrow m
, MonadCatch m , MonadCatch m
) )
=> m [Version] => m [VersionRev]
hlsGHCVersions = do hlsGHCVersions = do
h <- hlsSet h <- hlsSet
fromMaybe [] <$> forM h hlsGHCVersions' fromMaybe [] <$> forM h hlsGHCVersions'
@@ -579,12 +579,12 @@ hlsGHCVersions' :: ( MonadReader env m
, MonadThrow m , MonadThrow m
, MonadCatch m , MonadCatch m
) )
=> Version => VersionRev
-> m [Version] -> m [VersionRev]
hlsGHCVersions' v' = do hlsGHCVersions' v' = do
bins <- hlsServerBinaries v' Nothing bins <- hlsServerBinaries v' Nothing
let vers = fmap let vers = fmap
(version (versionRev
. T.pack . T.pack
. fromJust . fromJust
. stripPrefix "haskell-language-server-" . stripPrefix "haskell-language-server-"
@@ -597,10 +597,10 @@ hlsGHCVersions' v' = do
-- | Get all server binaries for an hls version from the ~/.ghcup/bin directory, if any. -- | Get all server binaries for an hls version from the ~/.ghcup/bin directory, if any.
hlsServerBinaries :: (MonadReader env m, HasDirs env, MonadIO m) hlsServerBinaries :: (MonadReader env m, HasDirs env, MonadIO m)
=> Version => VersionRev
-> Maybe Version -- ^ optional GHC version -> Maybe Version -- ^ optional GHC version
-> m [FilePath] -> m [FilePath]
hlsServerBinaries ver mghcVer = do hlsServerBinaries (VersionRev ver rv) mghcVer = do
Dirs {..} <- getDirs Dirs {..} <- getDirs
liftIO $ handleIO (\_ -> pure []) $ findFiles liftIO $ handleIO (\_ -> pure []) $ findFiles
binDir binDir
@@ -611,6 +611,7 @@ hlsServerBinaries ver mghcVer = do
<> maybe [s|.*|] escapeVerRex mghcVer <> maybe [s|.*|] escapeVerRex mghcVer
<> [s|~|] <> [s|~|]
<> escapeVerRex ver <> escapeVerRex ver
<> E.encodeUtf8 (T.pack ("-r" <> show rv))
<> E.encodeUtf8 (T.pack exeExt) <> E.encodeUtf8 (T.pack exeExt)
<> [s|$|] :: ByteString <> [s|$|] :: ByteString
) )
@@ -626,7 +627,7 @@ hlsInternalServerScripts ver mghcVer = do
dir <- ghcupHLSDir ver dir <- ghcupHLSDir ver
let bdir = fromGHCupPath dir </> "bin" let bdir = fromGHCupPath dir </> "bin"
fmap (bdir </>) . filter (\f -> maybe True (\gv -> ("-" <> T.unpack (prettyVer gv)) `isSuffixOf` f) mghcVer) fmap (bdir </>) . filter (\f -> maybe True (\gv -> ("-" <> T.unpack (prettyVer gv)) `isSuffixOf` f) mghcVer)
<$> liftIO (listDirectory bdir) <$> liftIO (listDirectoryFiles bdir)
-- | Get all binaries for a hls version from the ~/.ghcup/hls/<ver>/lib/haskell-language-server-<ver>/bin directory, if any. -- | Get all binaries for a hls version from the ~/.ghcup/hls/<ver>/lib/haskell-language-server-<ver>/bin directory, if any.
-- Returns the full path. -- Returns the full path.
@@ -639,7 +640,7 @@ hlsInternalServerBinaries ver mghcVer = do
let regex = makeRegexOpts compExtended execBlank ([s|^haskell-language-server-.*$|] :: ByteString) let regex = makeRegexOpts compExtended execBlank ([s|^haskell-language-server-.*$|] :: ByteString)
(Just bdir) <- fmap headMay $ liftIO $ expandFilePath [Left (dir </> "lib"), Right regex, Left "bin"] (Just bdir) <- fmap headMay $ liftIO $ expandFilePath [Left (dir </> "lib"), Right regex, Left "bin"]
fmap (bdir </>) . filter (\f -> maybe True (\gv -> ("-" <> T.unpack (prettyVer gv)) `isSuffixOf` f) mghcVer) fmap (bdir </>) . filter (\f -> maybe True (\gv -> ("-" <> T.unpack (prettyVer gv)) `isSuffixOf` f) mghcVer)
<$> liftIO (listDirectory bdir) <$> liftIO (listDirectoryFiles bdir)
-- | Get all libraries for a hls version from the ~/.ghcup/hls/<ver>/lib/haskell-language-server-<ver>/lib/<ghc-ver>/ -- | Get all libraries for a hls version from the ~/.ghcup/hls/<ver>/lib/haskell-language-server-<ver>/lib/<ghc-ver>/
-- directory, if any. -- directory, if any.
@@ -652,21 +653,25 @@ hlsInternalServerLibs ver ghcVer = do
dir <- fromGHCupPath <$> ghcupHLSDir ver dir <- fromGHCupPath <$> ghcupHLSDir ver
let regex = makeRegexOpts compExtended execBlank ([s|^haskell-language-server-.*$|] :: ByteString) let regex = makeRegexOpts compExtended execBlank ([s|^haskell-language-server-.*$|] :: ByteString)
(Just bdir) <- fmap headMay $ liftIO $ expandFilePath [Left (dir </> "lib"), Right regex, Left ("lib" </> T.unpack (prettyVer ghcVer))] (Just bdir) <- fmap headMay $ liftIO $ expandFilePath [Left (dir </> "lib"), Right regex, Left ("lib" </> T.unpack (prettyVer ghcVer))]
fmap (bdir </>) <$> liftIO (listDirectory bdir) fmap (bdir </>) <$> liftIO (listDirectoryFiles bdir)
-- | Get the wrapper binary for an hls version, if any. -- | Get the wrapper binary for an hls version, if any.
hlsWrapperBinary :: (MonadReader env m, HasDirs env, MonadThrow m, MonadIO m) hlsWrapperBinary :: (MonadReader env m, HasDirs env, MonadThrow m, MonadIO m)
=> Version => VersionRev
-> m (Maybe FilePath) -> m (Maybe FilePath)
hlsWrapperBinary ver = do hlsWrapperBinary (VersionRev ver rv) = do
Dirs {..} <- getDirs Dirs {..} <- getDirs
wrapper <- liftIO $ handleIO (\_ -> pure []) $ findFiles wrapper <- liftIO $ handleIO (\_ -> pure []) $ findFiles
binDir binDir
(makeRegexOpts (makeRegexOpts
compExtended compExtended
execBlank execBlank
([s|^haskell-language-server-wrapper-|] <> escapeVerRex ver <> E.encodeUtf8 (T.pack exeExt) <> [s|$|] :: ByteString ([s|^haskell-language-server-wrapper-|]
<> escapeVerRex ver
<> E.encodeUtf8 (T.pack ("-r" <> show rv))
<> E.encodeUtf8 (T.pack exeExt)
<> [s|$|] :: ByteString
) )
) )
case wrapper of case wrapper of
@@ -677,7 +682,7 @@ hlsWrapperBinary ver = do
-- | Get all binaries for an hls version, if any. -- | Get all binaries for an hls version, if any.
hlsAllBinaries :: (MonadReader env m, HasDirs env, MonadIO m, MonadThrow m) => Version -> m [FilePath] hlsAllBinaries :: (MonadReader env m, HasDirs env, MonadIO m, MonadThrow m) => VersionRev -> m [FilePath]
hlsAllBinaries ver = do hlsAllBinaries ver = do
hls <- hlsServerBinaries ver Nothing hls <- hlsServerBinaries ver Nothing
wrapper <- hlsWrapperBinary ver wrapper <- hlsWrapperBinary ver
@@ -781,6 +786,9 @@ getLatestToolFor tool pvpIn dls = do
let ps = catMaybes $ fmap (\(v, vi) -> (,vi) <$> versionToPVP v) ls let ps = catMaybes $ fmap (\(v, vi) -> (,vi) <$> versionToPVP v) ls
pure . fmap (first fst) . headMay . filter (\((v, _), _) -> matchPVPrefix pvpIn v) $ ps pure . fmap (first fst) . headMay . filter (\((v, _), _) -> matchPVPrefix pvpIn v) $ ps
-- type ToolVersionSpec = Map Version ToolRevisionSpec
-- type ToolRevisionSpec = Map Int VersionInfo
@@ -892,6 +900,9 @@ getTagged tag =
getLatest :: GHCupDownloads -> Tool -> Maybe (Version, VersionInfo) getLatest :: GHCupDownloads -> Tool -> Maybe (Version, 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 av tool = headOf (ix tool % getTagged LatestPrerelease) av
getRecommended :: GHCupDownloads -> Tool -> Maybe (Version, VersionInfo) getRecommended :: GHCupDownloads -> Tool -> Maybe (Version, VersionInfo)
getRecommended av tool = headOf (ix tool % getTagged Recommended) av getRecommended av tool = headOf (ix tool % getTagged Recommended) av
@@ -924,7 +935,7 @@ ghcInternalBinDir ver = do
-- --
-- - @["hsc2hs","haddock","hpc","runhaskell","ghc","ghc-pkg","ghci","runghc","hp2ps"]@ -- - @["hsc2hs","haddock","hpc","runhaskell","ghc","ghc-pkg","ghci","runghc","hp2ps"]@
ghcToolFiles :: (MonadReader env m, HasDirs env, MonadThrow m, MonadFail m, MonadIO m) ghcToolFiles :: (MonadReader env m, HasDirs env, MonadThrow m, MonadFail m, MonadIO m)
=> GHCTargetVersion => GHCTargetVersionRev
-> Excepts '[NotInstalled] m [FilePath] -> Excepts '[NotInstalled] m [FilePath]
ghcToolFiles ver = do ghcToolFiles ver = do
bindir <- ghcInternalBinDir ver bindir <- ghcInternalBinDir ver
@@ -933,7 +944,7 @@ ghcToolFiles ver = do
whenM (fmap not $ ghcInstalled ver) whenM (fmap not $ ghcInstalled ver)
(throwE (NotInstalled GHC ver)) (throwE (NotInstalled GHC ver))
files <- liftIO (listDirectory bindir >>= filterM (doesFileExist . (bindir </>))) files <- liftIO (listDirectoryFiles bindir >>= filterM (doesFileExist . (bindir </>)))
pure (getUniqueTools . groupToolFiles . fmap (dropSuffix exeExt) $ files) pure (getUniqueTools . groupToolFiles . fmap (dropSuffix exeExt) $ files)
where where
@@ -1282,7 +1293,7 @@ warnAboutHlsCompatibility :: ( MonadReader env m
=> m () => m ()
warnAboutHlsCompatibility = do warnAboutHlsCompatibility = do
supportedGHC <- hlsGHCVersions supportedGHC <- hlsGHCVersions
currentGHC <- fmap _tvVersion <$> ghcSet Nothing currentGHC <- fmap _tvVersionRev <$> ghcSet Nothing
currentHLS <- hlsSet currentHLS <- hlsSet
case (currentGHC, currentHLS) of case (currentGHC, currentHLS) of

View File

@@ -42,6 +42,9 @@ module GHCup.Utils.Dirs
, removeDirectoryRecursive , removeDirectoryRecursive
, removePathForcibly , removePathForcibly
, listDirectoryFiles
, listDirectoryDirs
-- System.Directory re-exports -- System.Directory re-exports
, createDirectory , createDirectory
, createDirectoryIfMissing , createDirectoryIfMissing
@@ -130,7 +133,7 @@ import Data.Maybe
import Data.Versions import Data.Versions
import GHC.IO.Exception ( IOErrorType(NoSuchThing) ) import GHC.IO.Exception ( IOErrorType(NoSuchThing) )
import Haskus.Utils.Variant.Excepts import Haskus.Utils.Variant.Excepts
import Optics import Optics hiding ( uncons )
import Safe import Safe
import System.Directory hiding ( removeDirectory import System.Directory hiding ( removeDirectory
, removeDirectoryRecursive , removeDirectoryRecursive
@@ -414,9 +417,9 @@ parseGHCupGHCDir :: MonadThrow m => FilePath -> m GHCTargetVersion
parseGHCupGHCDir (T.pack -> fp) = parseGHCupGHCDir (T.pack -> fp) =
throwEither $ MP.parse ghcTargetVerP "" fp throwEither $ MP.parse ghcTargetVerP "" fp
parseGHCupHLSDir :: MonadThrow m => FilePath -> m Version parseGHCupHLSDir :: MonadThrow m => FilePath -> m VersionRev
parseGHCupHLSDir (T.pack -> fp) = parseGHCupHLSDir (T.pack -> fp) =
throwEither $ MP.parse version' "" fp throwEither $ versionRev fp
-- TODO: inlined from GHCup.Prelude -- TODO: inlined from GHCup.Prelude
throwEither :: (Exception a, MonadThrow m) => Either a b -> m b throwEither :: (Exception a, MonadThrow m) => Either a b -> m b
@@ -529,6 +532,29 @@ cleanupTrash = do
) $ liftIO $ removePathForcibly (recycleDir `appendGHCupPath` fp)) ) $ liftIO $ removePathForcibly (recycleDir `appendGHCupPath` fp))
-- | List *actual files* in a directory, ignoring empty files and a couple
-- of blacklisted files, such as '.DS_Store' on mac.
listDirectoryFiles :: FilePath -> IO [FilePath]
listDirectoryFiles fp = do
listDirectory fp >>= filterM (doesFileExist . (fp </>)) <&> filter (\fp' -> not (isHidden fp') && not (isBlacklisted fp'))
-- | List *actual directories* in a directory, ignoring empty directories and a couple
-- of blacklisted files, such as '.DS_Store' on mac.
listDirectoryDirs :: FilePath -> IO [FilePath]
listDirectoryDirs fp = do
listDirectory fp >>= filterM (doesDirectoryExist . (fp </>)) <&> filter (\fp' -> not (isHidden fp') && not (isBlacklisted fp'))
isHidden :: FilePath -> Bool
isHidden fp'
| isWindows = False
| Just ('.', _) <- uncons fp' = True
| otherwise = False
isBlacklisted :: FilePath -> Bool
{- HLINT ignore "Use ==" -}
isBlacklisted fp' = fp' `elem` [".DS_Store"]
-- System.Directory re-exports with GHCupPath -- System.Directory re-exports with GHCupPath

View File

@@ -28,7 +28,7 @@
plat="$(uname -s)" plat="$(uname -s)"
arch=$(uname -m) arch=$(uname -m)
ghver="0.1.19.0" ghver="0.1.19.2"
: "${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

@@ -7,6 +7,7 @@ shopt -s extglob
RELEASE=$1 RELEASE=$1
SIGNER=$2 SIGNER=$2
TAG=${RELEASE/v/}
echo "RELEASE: $RELEASE" echo "RELEASE: $RELEASE"
echo "SIGNER: $SIGNER" echo "SIGNER: $SIGNER"
@@ -18,17 +19,19 @@ done
[ ! -e "gh-release-artifacts/${RELEASE}" ] [ ! -e "gh-release-artifacts/${RELEASE}" ]
mkdir -p "gh-release-artifacts/${RELEASE}" mkdir -p "gh-release-artifacts/${RELEASE}"
git archive --format=tar.gz -o "gh-release-artifacts/${RELEASE}/ghcup-${TAG}-src.tar.gz" --prefix="ghcup-${TAG}/" HEAD
cd "gh-release-artifacts/${RELEASE}" cd "gh-release-artifacts/${RELEASE}"
# github # github
gh release download $RELEASE gh release download "$RELEASE"
rm test-*
# cirrus # cirrus
curl -L -o x86_64-portbld-freebsd-ghcup-${RELEASE} \ curl -L -o "x86_64-portbld-freebsd-ghcup-${TAG}" \
"https://api.cirrus-ci.com/v1/artifact/github/haskell/ghcup-hs/build/binaries/out/x86_64-portbld-freebsd-ghcup-${RELEASE}?branch=${RELEASE}" "https://api.cirrus-ci.com/v1/artifact/github/haskell/ghcup-hs/build/binaries/out/x86_64-portbld-freebsd-ghcup-${RELEASE}?branch=${RELEASE}"
sha256sum *ghcup* > SHA256SUMS sha256sum ./*-ghcup-* > SHA256SUMS
gpg --detach-sign -u "${SIGNER}" SHA256SUMS gpg --detach-sign -u "${SIGNER}" SHA256SUMS
gh release upload "$RELEASE" "ghcup-${TAG}-src.tar.gz" "x86_64-portbld-freebsd-ghcup-${TAG}" SHA256SUMS SHA256SUMS.sig

View File

@@ -21,8 +21,7 @@ rm i386-linux-ghcup
rm x86_64-apple-darwin-ghcup rm x86_64-apple-darwin-ghcup
rm x86_64-linux-ghcup rm x86_64-linux-ghcup
rm x86_64-mingw64-ghcup.exe rm x86_64-mingw64-ghcup.exe
rm x86_64-freebsd12-ghcup rm x86_64-portbld-freebsd-ghcup
rm x86_64-freebsd13-ghcup
symlink ${ver}/aarch64-apple-darwin-ghcup-${ver} aarch64-apple-darwin-ghcup symlink ${ver}/aarch64-apple-darwin-ghcup-${ver} aarch64-apple-darwin-ghcup
symlink ${ver}/aarch64-linux-ghcup-${ver} aarch64-linux-ghcup symlink ${ver}/aarch64-linux-ghcup-${ver} aarch64-linux-ghcup

View File

@@ -147,6 +147,10 @@ instance Arbitrary Architecture where
arbitrary = genericArbitrary arbitrary = genericArbitrary
shrink = genericShrink shrink = genericShrink
instance Arbitrary VersionDownload where
arbitrary = genericArbitrary
shrink = genericShrink
instance Arbitrary VersionInfo where instance Arbitrary VersionInfo where
arbitrary = genericArbitrary arbitrary = genericArbitrary
shrink = genericShrink shrink = genericShrink

File diff suppressed because it is too large Load Diff

File diff suppressed because it is too large Load Diff