Compare commits

..

5 Commits

Author SHA1 Message Date
16ae69e994 Fix property tests 2023-10-13 18:08:16 +08:00
94888e9d8e Add temp git ref to versions to fix CI 2023-10-13 17:52:39 +08:00
Colin Woodbury
cc7cc8c0e4 refactor: use upstream TH constructors 2023-10-13 17:35:39 +09:00
Colin Woodbury
28cb01539d chore: bump versions upper bound and squash warnings 2023-10-13 17:31:17 +09:00
Colin Woodbury
8aa05f311e refactor: upgrade versions library usage 2023-10-13 17:09:35 +09:00
11 changed files with 1171 additions and 1187 deletions

View File

@@ -30,32 +30,32 @@ sha_sum "$(raw_eghcup --offline whereis ghcup)"
### Haskell test suite ### Haskell test suite
./"ghcup-test${ext}" ./ghcup-test${ext}
./"ghcup-test-optparse${ext}" ./ghcup-test-optparse${ext}
rm "ghcup-test${ext}" "ghcup-test-optparse${ext}" rm ghcup-test${ext} ghcup-test-optparse${ext}
### manual cli based testing ### manual cli based testing
eghcup --numeric-version eghcup --numeric-version
eghcup install ghc "${GHC_VER}" eghcup install ghc ${GHC_VER}
eghcup unset ghc "${GHC_VER}" eghcup unset ghc ${GHC_VER}
ls -lah "$(eghcup whereis -d ghc "${GHC_VER}")" ls -lah "$(eghcup whereis -d ghc ${GHC_VER})"
[ "$($(eghcup whereis ghc "${GHC_VER}") --numeric-version)" = "${GHC_VER}" ] [ "`$(eghcup whereis ghc ${GHC_VER}) --numeric-version`" = "${GHC_VER}" ]
[ "$(eghcup run -q --ghc "${GHC_VER}" -- ghc --numeric-version)" = "${GHC_VER}" ] [ "`eghcup run --ghc ${GHC_VER} -- ghc --numeric-version`" = "${GHC_VER}" ]
[ "$(ghcup run -q --ghc "${GHC_VER}" -- ghc -e 'Control.Monad.join (Control.Monad.fmap System.IO.putStr System.Environment.getExecutablePath)')" = "$($(ghcup whereis ghc "${GHC_VER}") -e 'Control.Monad.join (Control.Monad.fmap System.IO.putStr System.Environment.getExecutablePath)')" ] [ "`ghcup run --ghc ${GHC_VER} -- ghc -e 'Control.Monad.join (Control.Monad.fmap System.IO.putStr System.Environment.getExecutablePath)'`" = "`$(ghcup whereis ghc ${GHC_VER}) -e 'Control.Monad.join (Control.Monad.fmap System.IO.putStr System.Environment.getExecutablePath)'`" ]
eghcup set ghc "${GHC_VER}" eghcup set ghc ${GHC_VER}
eghcup install cabal "${CABAL_VER}" eghcup install cabal ${CABAL_VER}
[ "$($(eghcup whereis cabal "${CABAL_VER}") --numeric-version)" = "${CABAL_VER}" ] [ "`$(eghcup whereis cabal ${CABAL_VER}) --numeric-version`" = "${CABAL_VER}" ]
eghcup unset cabal eghcup unset cabal
"$GHCUP_BIN"/cabal --version && exit 1 || echo yes "$GHCUP_BIN"/cabal --version && exit 1 || echo yes
# make sure no cabal is set when running 'ghcup run' to check that PATH propagages properly # make sure no cabal is set when running 'ghcup run' to check that PATH propagages properly
# https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/375 # https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/375
[ "$(eghcup run -q --cabal "${CABAL_VER}" -- cabal --numeric-version)" = "${CABAL_VER}" ] [ "`eghcup run --cabal ${CABAL_VER} -- cabal --numeric-version`" = "${CABAL_VER}" ]
eghcup set cabal "${CABAL_VER}" eghcup set cabal ${CABAL_VER}
[ "$($(eghcup whereis cabal "${CABAL_VER}") --numeric-version)" = "${CABAL_VER}" ] [ "`$(eghcup whereis cabal ${CABAL_VER}) --numeric-version`" = "${CABAL_VER}" ]
if [ "${OS}" != "FreeBSD" ] ; then if [ "${OS}" != "FreeBSD" ] ; then
if [ "${ARCH}" = "64" ] && [ "${DISTRO}" != "Alpine" ] ; then if [ "${ARCH}" = "64" ] && [ "${DISTRO}" != "Alpine" ] ; then
@@ -85,10 +85,10 @@ eghcup list -t cabal
ghc_ver=$(ghc --numeric-version) ghc_ver=$(ghc --numeric-version)
ghc --version ghc --version
"ghc-${ghc_ver}" --version ghc-${ghc_ver} --version
if [ "${OS}" != "Windows" ] ; then if [ "${OS}" != "Windows" ] ; then
ghci --version ghci --version
"ghci-${ghc_ver}" --version ghci-${ghc_ver} --version
fi fi
@@ -132,11 +132,11 @@ else
eghcup --offline set 8.10.3 eghcup --offline set 8.10.3
eghcup set 8.10.3 eghcup set 8.10.3
[ "$(ghc --numeric-version)" = "8.10.3" ] [ "$(ghc --numeric-version)" = "8.10.3" ]
eghcup set "${GHC_VER}" eghcup set ${GHC_VER}
[ "$(ghc --numeric-version)" = "${ghc_ver}" ] [ "$(ghc --numeric-version)" = "${ghc_ver}" ]
eghcup unset ghc eghcup unset ghc
"$GHCUP_BIN"/ghc --numeric-version && exit 1 || echo yes "$GHCUP_BIN"/ghc --numeric-version && exit 1 || echo yes
eghcup set "${GHC_VER}" eghcup set ${GHC_VER}
eghcup --offline rm 8.10.3 eghcup --offline rm 8.10.3
[ "$(ghc --numeric-version)" = "${ghc_ver}" ] [ "$(ghc --numeric-version)" = "${ghc_ver}" ]
@@ -169,10 +169,10 @@ fi
# check that lazy loading works for 'whereis' # check that lazy loading works for 'whereis'
cp "$CI_PROJECT_DIR/data/metadata/ghcup-${JSON_VERSION}.yaml" "$CI_PROJECT_DIR/data/metadata/ghcup-${JSON_VERSION}.yaml.bak" cp "$CI_PROJECT_DIR/data/metadata/ghcup-${JSON_VERSION}.yaml" "$CI_PROJECT_DIR/data/metadata/ghcup-${JSON_VERSION}.yaml.bak"
echo '**' > "$CI_PROJECT_DIR/data/metadata/ghcup-${JSON_VERSION}.yaml" echo '**' > "$CI_PROJECT_DIR/data/metadata/ghcup-${JSON_VERSION}.yaml"
eghcup whereis ghc "$(ghc --numeric-version)" eghcup whereis ghc $(ghc --numeric-version)
mv -f "$CI_PROJECT_DIR/data/metadata/ghcup-${JSON_VERSION}.yaml.bak" "$CI_PROJECT_DIR/data/metadata/ghcup-${JSON_VERSION}.yaml" mv -f "$CI_PROJECT_DIR/data/metadata/ghcup-${JSON_VERSION}.yaml.bak" "$CI_PROJECT_DIR/data/metadata/ghcup-${JSON_VERSION}.yaml"
eghcup rm "$(ghc --numeric-version)" eghcup rm $(ghc --numeric-version)
# https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/116 # https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/116
if [ "${OS}" = "Linux" ] ; then if [ "${OS}" = "Linux" ] ; then
@@ -186,7 +186,7 @@ eghcup gc -c
# test etags # test etags
rm -f "${GHCUP_DIR}/cache/ghcup-${JSON_VERSION}.yaml" rm -f "${GHCUP_DIR}/cache/ghcup-${JSON_VERSION}.yaml"
raw_eghcup -s "https://www.haskell.org/ghcup/data/ghcup-${JSON_VERSION}.yaml" list raw_eghcup -s https://www.haskell.org/ghcup/data/ghcup-${JSON_VERSION}.yaml list
# snapshot yaml and etags file # snapshot yaml and etags file
etag=$(cat "${GHCUP_DIR}/cache/ghcup-${JSON_VERSION}.yaml.etags") etag=$(cat "${GHCUP_DIR}/cache/ghcup-${JSON_VERSION}.yaml.etags")
sha=$(sha_sum "${GHCUP_DIR}/cache/ghcup-${JSON_VERSION}.yaml") sha=$(sha_sum "${GHCUP_DIR}/cache/ghcup-${JSON_VERSION}.yaml")

2
.gitmodules vendored
View File

@@ -1,4 +1,4 @@
[submodule "data/metadata"] [submodule "data/metadata"]
path = data/metadata path = data/metadata
url = https://github.com/haskell/ghcup-metadata.git url = https://github.com/haskell/ghcup-metadata.git
branch = develop branch = master

View File

@@ -214,7 +214,17 @@ url-source:
Stack manages GHC versions internally by default. In order to make it use ghcup installed Stack manages GHC versions internally by default. In order to make it use ghcup installed
GHC versions there are two strategies. GHC versions there are two strategies.
### Strategy 1: Stack hooks (new, recommended) ### Strategy 1: System GHC (works on all stack versions)
You can instruct stack to use "system" GHC versions (whatever is in PATH). To do so,
run the following commands:
```sh
stack config set install-ghc false --global
stack config set system-ghc true --global
```
### Strategy 2: Stack hooks (new, recommended)
Since stack 2.9.1 you can customize the installation logic of GHC completely, see [https://docs.haskellstack.org/en/stable/yaml_configuration/#ghc-installation-customisation](https://docs.haskellstack.org/en/stable/yaml_configuration/#ghc-installation-customisation). Since stack 2.9.1 you can customize the installation logic of GHC completely, see [https://docs.haskellstack.org/en/stable/yaml_configuration/#ghc-installation-customisation](https://docs.haskellstack.org/en/stable/yaml_configuration/#ghc-installation-customisation).
@@ -236,16 +246,6 @@ stack config set system-ghc false --global
By default, when the hook fails for whatever reason, stack will fall back to its own installation logic. To disable By default, when the hook fails for whatever reason, stack will fall back to its own installation logic. To disable
this, run `stack config set install-ghc false --global`. this, run `stack config set install-ghc false --global`.
### Strategy 2: System GHC (works on all stack versions)
You can instruct stack to use "system" GHC versions (whatever is in PATH). To do so,
run the following commands:
```sh
stack config set install-ghc false --global
stack config set system-ghc true --global
```
### Windows ### Windows
On windows, you may find the following config options useful too: On windows, you may find the following config options useful too:
@@ -456,48 +456,8 @@ variables and, in the case of Windows, parameters to tweak the script behavior.
### github workflows ### github workflows
On github workflows GHCup itself is pre-installed on all platforms, but may use non-standard install locations. On github workflows you can use [https://github.com/haskell/actions/](https://github.com/haskell/actions/).
Here's an example workflow with a GHC matrix: GHCup itself is also pre-installed on all platforms, but may use non-standard install locations.
```yaml
jobs:
build:
runs-on: ${{ matrix.os }}
strategy:
fail-fast: true
matrix:
os: [ubuntu-22.04, macOS-latest]
ghc: ['9.6', '9.4', '9.2', '9.0', '8.10', '8.8', '8.6']
steps:
- uses: actions/checkout@v3
- name: Setup toolchain
run: |
ghcup install cabal --set recommended
ghcup install ghc --set ${{ matrix.ghc }}
- name: Build
run: |
cabal update
cabal test all --test-show-details=direct
i386:
runs-on: ubuntu-latest
container:
image: i386/ubuntu:bionic
steps:
- name: Install GHCup in container
run: |
apt-get update -y
apt-get install -y autoconf build-essential zlib1g-dev libgmp-dev curl
# we just go with recommended versions of cabal and GHC
curl --proto '=https' --tlsv1.2 -sSf https://get-ghcup.haskell.org | BOOTSTRAP_HASKELL_NONINTERACTIVE=1 BOOTSTRAP_HASKELL_INSTALL_NO_STACK=1 sh
- uses: actions/checkout@v1
- name: Test
run: |
# in containers we need to fix PATH
source ~/.ghcup/env
cabal update
cabal test all --test-show-details=direct
```
## GPG verification ## GPG verification

View File

@@ -42,14 +42,10 @@ Also see [tags and shortcuts](../guide/#tags-and-shortcuts) for more information
The following distro packages are required: `build-essential curl libffi-dev libffi6 libgmp-dev libgmp10 libncurses-dev libncurses5 libtinfo5` The following distro packages are required: `build-essential curl libffi-dev libffi6 libgmp-dev libgmp10 libncurses-dev libncurses5 libtinfo5`
#### Version >= 11 && <= 12 #### Version >= 11
The following distro packages are required: `build-essential curl libffi-dev libffi7 libgmp-dev libgmp10 libncurses-dev libncurses5 libtinfo5` The following distro packages are required: `build-essential curl libffi-dev libffi7 libgmp-dev libgmp10 libncurses-dev libncurses5 libtinfo5`
#### Version >= 12
The following distro packages are required: `build-essential curl libffi-dev libffi8 libgmp-dev libgmp10 libncurses-dev libncurses5 libtinfo5`
### Linux Ubuntu ### Linux Ubuntu
#### Generic #### Generic
@@ -60,13 +56,10 @@ The following distro packages are required: `build-essential curl libffi-dev lib
The following distro packages are required: `build-essential curl libffi-dev libffi7 libgmp-dev libgmp10 libncurses-dev libncurses5 libtinfo5` The following distro packages are required: `build-essential curl libffi-dev libffi7 libgmp-dev libgmp10 libncurses-dev libncurses5 libtinfo5`
#### Version >= 20.10 && < 23 #### Version >= 20.10
The following distro packages are required: `build-essential curl libffi-dev libffi8ubuntu1 libgmp-dev libgmp10 libncurses-dev libncurses5 libtinfo5` The following distro packages are required: `build-essential curl libffi-dev libffi8ubuntu1 libgmp-dev libgmp10 libncurses-dev libncurses5 libtinfo5`
#### Version >= 23
The following distro packages are required: `build-essential curl libffi-dev libffi8ubuntu1 libgmp-dev libgmp10 libncurses-dev`
### Linux Fedora ### Linux Fedora
@@ -207,9 +200,7 @@ GHCup supports the following tools, which are also known as the **Haskell Toolch
<table> <table>
<thead><tr><th>HLS Version</th><th>Tags</th></tr></thead> <thead><tr><th>HLS Version</th><th>Tags</th></tr></thead>
<tbody> <tbody>
<tr><td>2.4.0.0</td><td><span style="color:blue">latest</span>, <span style="color:green">recommended</span></td></tr> <tr><td>2.2.0.0</td><td><span style="color:blue">latest</span>, <span style="color:green">recommended</span></td></tr>
<tr><td>2.3.0.0</td><td></td></tr>
<tr><td>2.2.0.0</td><td></td></tr>
<tr><td>2.1.0.0</td><td></td></tr> <tr><td>2.1.0.0</td><td></td></tr>
<tr><td>2.0.0.1</td><td></td></tr> <tr><td>2.0.0.1</td><td></td></tr>
<tr><td>2.0.0.0</td><td></td></tr> <tr><td>2.0.0.0</td><td></td></tr>

View File

@@ -209,7 +209,19 @@ platformParser s' = case MP.parse (platformP <* MP.eof) "" (T.pack s') of
) )
] ]
distroP :: MP.Parsec Void Text LinuxDistro distroP :: MP.Parsec Void Text LinuxDistro
distroP = choice' ((\d -> MP.chunk (T.pack $ distroToString d) $> d) <$> allDistros) distroP = choice'
[ MP.chunk "debian" $> Debian
, MP.chunk "deb" $> Debian
, MP.chunk "ubuntu" $> Ubuntu
, MP.chunk "mint" $> Mint
, MP.chunk "fedora" $> Fedora
, MP.chunk "centos" $> CentOS
, MP.chunk "redhat" $> RedHat
, MP.chunk "alpine" $> Alpine
, MP.chunk "gentoo" $> Gentoo
, MP.chunk "exherbo" $> Exherbo
, MP.chunk "unknown" $> UnknownLinux
]
uriParser :: String -> Either String URI uriParser :: String -> Either String URI
@@ -355,7 +367,7 @@ fileUri' add = \case
-- We need to do this so bash doesn't expand out any ~ or other -- We need to do this so bash doesn't expand out any ~ or other
-- chars we want to complete on, or emit an end of line error -- chars we want to complete on, or emit an end of line error
-- when seeking the close to the quote. -- when seeking the close to the quote.
-- --
-- NOTE: copied from https://hackage.haskell.org/package/optparse-applicative-0.17.0.0/docs/src/Options.Applicative.Builder.Completer.html#requote -- NOTE: copied from https://hackage.haskell.org/package/optparse-applicative-0.17.0.0/docs/src/Options.Applicative.Builder.Completer.html#requote
requote :: String -> String requote :: String -> String
requote s = requote s =

View File

@@ -246,7 +246,7 @@ getBase uri = do
Settings { metaCache } <- lift getSettings Settings { metaCache } <- lift getSettings
-- for local files, let's short-circuit and ignore access time -- for local files, let's short-circuit and ignore access time
if | scheme == "file" -> liftE $ download uri' (Just $ over pathL' (<> ".sig") uri') Nothing Nothing (fromGHCupPath cacheDir) Nothing True if | scheme == "file" -> liftE $ download uri' Nothing Nothing Nothing (fromGHCupPath cacheDir) Nothing True
| e -> do | e -> do
accessTime <- fmap utcTimeToPOSIXSeconds $ liftIO $ getAccessTime json_file accessTime <- fmap utcTimeToPOSIXSeconds $ liftIO $ getAccessTime json_file
let sinceLastAccess = utcTimeToPOSIXSeconds currentTime - accessTime let sinceLastAccess = utcTimeToPOSIXSeconds currentTime - accessTime
@@ -352,20 +352,15 @@ download :: ( MonadReader env m
download rawUri gpgUri eDigest eCSize dest mfn etags download rawUri gpgUri eDigest eCSize dest mfn etags
| scheme == "https" = liftE dl | scheme == "https" = liftE dl
| scheme == "http" = liftE dl | scheme == "http" = liftE dl
| scheme == "file"
, Just s <- gpgScheme
, s /= "file" = throwIO $ userError $ "gpg scheme does not match base file scheme: " <> (T.unpack . decUTF8Safe $ s)
| scheme == "file" = do | scheme == "file" = do
Settings{ gpgSetting } <- lift getSettings
let destFile' = T.unpack . decUTF8Safe $ view pathL' rawUri let destFile' = T.unpack . decUTF8Safe $ view pathL' rawUri
lift $ logDebug $ "using local file: " <> T.pack destFile' lift $ logDebug $ "using local file: " <> T.pack destFile'
liftE $ verify gpgSetting destFile' (pure . T.unpack . decUTF8Safe . view pathL') forM_ eDigest (liftE . flip checkDigest destFile')
pure destFile' pure destFile'
| otherwise = throwE $ DownloadFailed (variantFromValue UnsupportedScheme) | otherwise = throwE $ DownloadFailed (variantFromValue UnsupportedScheme)
where where
scheme = view (uriSchemeL' % schemeBSL') rawUri scheme = view (uriSchemeL' % schemeBSL') rawUri
gpgScheme = view (uriSchemeL' % schemeBSL') <$> gpgUri
dl = do dl = do
Settings{ mirrors } <- lift getSettings Settings{ mirrors } <- lift getSettings
let uri = applyMirrors mirrors rawUri let uri = applyMirrors mirrors rawUri
@@ -407,14 +402,30 @@ download rawUri gpgUri eDigest eCSize dest mfn etags
else pure (\fp -> liftE . internalDL fp) else pure (\fp -> liftE . internalDL fp)
#endif #endif
liftE $ downloadAction baseDestFile uri liftE $ downloadAction baseDestFile uri
liftE $ verify gpgSetting baseDestFile case (gpgUri, gpgSetting) of
(\uri' -> do (_, GPGNone) -> pure ()
gpgDestFile <- liftE . reThrowAll @_ @_ @'[DownloadFailed] DownloadFailed $ getDestFile uri' Nothing (Just gpgUri', _) -> do
lift $ logDebug $ "downloading: " <> (decUTF8Safe . serializeURIRef') uri' <> " as file " <> T.pack gpgDestFile gpgDestFile <- liftE . reThrowAll @_ @_ @'[DownloadFailed] DownloadFailed $ getDestFile gpgUri' Nothing
flip onException (lift $ hideError doesNotExistErrorType $ recycleFile (tmpFile gpgDestFile)) $ liftE $ flip onException
downloadAction gpgDestFile uri' (lift $ hideError doesNotExistErrorType $ recycleFile (tmpFile gpgDestFile))
pure gpgDestFile $ catchAllE @_ @'[GPGError, ProcessError, UnsupportedScheme, DownloadFailed] @'[GPGError]
) (\e -> if gpgSetting == GPGStrict then throwE (GPGError e) else lift $ logWarn $ T.pack (prettyHFError (GPGError e))
) $ do
o' <- liftIO getGpgOpts
lift $ logDebug $ "downloading: " <> (decUTF8Safe . serializeURIRef') gpgUri' <> " as file " <> T.pack gpgDestFile
liftE $ downloadAction gpgDestFile gpgUri'
lift $ logInfo $ "verifying signature of: " <> T.pack baseDestFile
let args = o' ++ ["--batch", "--verify", "--quiet", "--no-tty", gpgDestFile, baseDestFile]
cp <- lift $ executeOut "gpg" args Nothing
case cp of
CapturedProcess { _exitCode = ExitFailure i, _stdErr } -> do
lift $ logDebug $ decUTF8Safe' _stdErr
throwE (GPGError @'[ProcessError] (V (NonZeroExit i "gpg" args)))
CapturedProcess { _stdErr } -> lift $ logDebug $ decUTF8Safe' _stdErr
_ -> pure ()
forM_ eCSize (liftE . flip checkCSize baseDestFile)
forM_ eDigest (liftE . flip checkDigest baseDestFile)
pure baseDestFile pure baseDestFile
curlDL :: ( MonadCatch m curlDL :: ( MonadCatch m
@@ -612,41 +623,6 @@ download rawUri gpgUri eDigest eCSize dest mfn etags
liftIO $ hideError doesNotExistErrorType $ rmFile (etagsFile fp) liftIO $ hideError doesNotExistErrorType $ rmFile (etagsFile fp)
pure Nothing pure Nothing
verify :: ( MonadReader env m
, HasLog env
, HasDirs env
, HasSettings env
, MonadCatch m
, MonadMask m
, MonadIO m
)
=> GPGSetting
-> FilePath
-> (URI -> Excepts '[ProcessError, DownloadFailed, UnsupportedScheme] m FilePath)
-> Excepts '[DigestError, ContentLengthError, DownloadFailed, GPGError] m ()
verify gpgSetting destFile' downloadAction' = do
case (gpgUri, gpgSetting) of
(_, GPGNone) -> pure ()
(Just gpgUri', _) -> do
liftE $ catchAllE @_ @'[GPGError, ProcessError, UnsupportedScheme, DownloadFailed] @'[GPGError]
(\e -> if gpgSetting == GPGStrict then throwE (GPGError e) else lift $ logWarn $ T.pack (prettyHFError (GPGError e))
) $ do
o' <- liftIO getGpgOpts
gpgDestFile <- liftE $ downloadAction' gpgUri'
lift $ logInfo $ "verifying signature of: " <> T.pack destFile'
let args = o' ++ ["--batch", "--verify", "--quiet", "--no-tty", gpgDestFile, destFile']
cp <- lift $ executeOut "gpg" args Nothing
case cp of
CapturedProcess { _exitCode = ExitFailure i, _stdErr } -> do
lift $ logDebug $ decUTF8Safe' _stdErr
throwE (GPGError @'[ProcessError] (V (NonZeroExit i "gpg" args)))
CapturedProcess { _stdErr } -> lift $ logDebug $ decUTF8Safe' _stdErr
_ -> pure ()
forM_ eCSize (liftE . flip checkCSize destFile')
forM_ eDigest (liftE . flip checkDigest destFile')
-- | Download into tmpdir or use cached version, if it exists. If filename -- | Download into tmpdir or use cached version, if it exists. If filename
-- is omitted, infers the filename from the url. -- is omitted, infers the filename from the url.
@@ -666,7 +642,7 @@ downloadCached :: ( MonadReader env m
downloadCached dli mfn = do downloadCached dli mfn = do
Settings{ cache } <- lift getSettings Settings{ cache } <- lift getSettings
case cache of case cache of
True -> liftE $ downloadCached' dli mfn Nothing True -> downloadCached' dli mfn Nothing
False -> do False -> do
tmp <- lift withGHCupTmpDir tmp <- lift withGHCupTmpDir
liftE $ download (_dlUri dli) Nothing (Just (_dlHash dli)) (_dlCSize dli) (fromGHCupPath tmp) outputFileName False liftE $ download (_dlUri dli) Nothing (Just (_dlHash dli)) (_dlCSize dli) (fromGHCupPath tmp) outputFileName False

View File

@@ -249,18 +249,13 @@ data LinuxDistro = Debian
| RedHat | RedHat
| Alpine | Alpine
| AmazonLinux | AmazonLinux
| Rocky
| Void
-- rolling -- rolling
| Gentoo | Gentoo
| Exherbo | Exherbo
-- not known -- not known
| UnknownLinux | UnknownLinux
-- ^ must exit -- ^ must exit
deriving (Eq, GHC.Generic, Ord, Show, Enum, Bounded) deriving (Eq, GHC.Generic, Ord, Show)
allDistros :: [LinuxDistro]
allDistros = enumFromTo minBound maxBound
instance NFData LinuxDistro instance NFData LinuxDistro
@@ -273,8 +268,6 @@ distroToString CentOS = "centos"
distroToString RedHat = "redhat" distroToString RedHat = "redhat"
distroToString Alpine = "alpine" distroToString Alpine = "alpine"
distroToString AmazonLinux = "amazon" distroToString AmazonLinux = "amazon"
distroToString Rocky = "rocky"
distroToString Void = "void"
distroToString Gentoo = "gentoo" distroToString Gentoo = "gentoo"
distroToString Exherbo = "exherbo" distroToString Exherbo = "exherbo"
distroToString UnknownLinux = "unknown" distroToString UnknownLinux = "unknown"

View File

@@ -369,9 +369,7 @@ cabalSet = do
handleIO' NoSuchThing (\_ -> pure Nothing) $ do handleIO' NoSuchThing (\_ -> pure Nothing) $ do
broken <- liftIO $ isBrokenSymlink cabalbin broken <- liftIO $ isBrokenSymlink cabalbin
if broken if broken
then do then pure Nothing
logWarn $ "Broken symlink at " <> T.pack cabalbin
pure Nothing
else do else do
link <- liftIO link <- liftIO
$ handleIO' InvalidArgument $ handleIO' InvalidArgument
@@ -468,9 +466,7 @@ stackSet = do
handleIO' NoSuchThing (\_ -> pure Nothing) $ do handleIO' NoSuchThing (\_ -> pure Nothing) $ do
broken <- liftIO $ isBrokenSymlink stackBin broken <- liftIO $ isBrokenSymlink stackBin
if broken if broken
then do then pure Nothing
logWarn $ "Broken symlink at " <> T.pack stackBin
pure Nothing
else do else do
link <- liftIO link <- liftIO
$ handleIO' InvalidArgument $ handleIO' InvalidArgument
@@ -524,17 +520,15 @@ isLegacyHLS ver = do
-- Return the currently set hls version, if any. -- Return the currently set hls version, if any.
hlsSet :: (HasLog env, 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 Version)
hlsSet = do hlsSet = do
Dirs {..} <- getDirs Dirs {..} <- getDirs
let hlsBin = binDir </> "haskell-language-server-wrapper" <> exeExt let hlsBin = binDir </> "haskell-language-server-wrapper" <> exeExt
handleIO' NoSuchThing (\_ -> pure Nothing) $ do liftIO $ handleIO' NoSuchThing (\_ -> pure Nothing) $ do
broken <- liftIO $ isBrokenSymlink hlsBin broken <- isBrokenSymlink hlsBin
if broken if broken
then do then pure Nothing
logWarn $ "Broken symlink at " <> T.pack hlsBin
pure Nothing
else do else do
link <- liftIO $ getLinkTarget hlsBin link <- liftIO $ getLinkTarget hlsBin
Just <$> linkVersion link Just <$> linkVersion link
@@ -562,7 +556,6 @@ hlsSet = do
-- | Return the GHC versions the currently selected HLS supports. -- | Return the GHC versions the currently selected HLS supports.
hlsGHCVersions :: ( MonadReader env m hlsGHCVersions :: ( MonadReader env m
, HasDirs env , HasDirs env
, HasLog env
, MonadIO m , MonadIO m
, MonadThrow m , MonadThrow m
, MonadCatch m , MonadCatch m
@@ -1086,7 +1079,7 @@ darwinNotarization :: (MonadReader env m, HasDirs env, MonadIO m)
-> FilePath -> FilePath
-> m (Either ProcessError ()) -> m (Either ProcessError ())
darwinNotarization Darwin path = exec darwinNotarization Darwin path = exec
"/usr/bin/xattr" "xattr"
["-r", "-d", "com.apple.quarantine", path] ["-r", "-d", "com.apple.quarantine", path]
Nothing Nothing
Nothing Nothing

View File

@@ -34,7 +34,7 @@ import Data.Void (Void)
-- Note that when updating this, CI requires that the file exsists AND the same file exists at -- Note that when updating this, CI requires that the file exsists AND the same file exists at
-- 'https://www.haskell.org/ghcup/exp/ghcup-<ver>.yaml' with some newlines added. -- 'https://www.haskell.org/ghcup/exp/ghcup-<ver>.yaml' with some newlines added.
ghcupURL :: URI ghcupURL :: URI
ghcupURL = [uri|https://raw.githubusercontent.com/haskell/ghcup-metadata/master/ghcup-0.0.8.yaml|] ghcupURL = [uri|https://raw.githubusercontent.com/haskell/ghcup-metadata/master/ghcup-0.0.7.yaml|]
-- | The current ghcup version. -- | The current ghcup version.
ghcUpVer :: V.PVP ghcUpVer :: V.PVP
@@ -53,7 +53,7 @@ versionCmp ver1 (VR_eq ver2) = ver1 == ver2
versionRange :: V.Versioning -> VersionRange -> Bool versionRange :: V.Versioning -> VersionRange -> Bool
versionRange ver' (SimpleRange cmps) = all (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
pvpToVersion :: MonadThrow m => V.PVP -> Text -> m V.Version pvpToVersion :: MonadThrow m => V.PVP -> Text -> m V.Version

File diff suppressed because it is too large Load Diff