Compare commits

...

27 Commits

Author SHA1 Message Date
e9db8f9895 WIP 2021-11-11 21:10:13 +01:00
7f542646dd Rename lots of modules 2021-11-05 22:57:15 +01:00
34910f853b Split GHCup.Utils.File module 2021-11-05 22:30:47 +01:00
c05876cc60 Fix build with ghc-8.6.5 2021-11-02 19:53:22 +01:00
b9c4c9a0b7 Fix hlint 2021-11-02 10:57:27 +01:00
6697e804ee Merge branch 'fix-ghc-version-parser' 2021-11-02 10:56:21 +01:00
2c57def8f1 Fix parsing of atypical ghc versions 2021-11-02 01:22:06 +01:00
62b16e957b Merge branch 'issue-276' 2021-10-30 14:17:52 +02:00
18d7bdd85c Merge branch 'issue-278' 2021-10-30 14:17:11 +02:00
190b5dedba Allow to control the metadata cache, fixes #278 2021-10-30 14:16:45 +02:00
886e45f788 Update hie.yaml 2021-10-30 13:47:45 +02:00
360daf2a09 Make upgrading ghcup in TUI more pleasant 2021-10-30 12:54:05 +02:00
7bb67dd4c6 Merge branch 'ghcup-gen' 2021-10-27 15:55:51 +02:00
72c4ea70c4 Migrate ghcup-gen to haskell/ghcup-metadata 2021-10-27 15:33:39 +02:00
0ae42dd71e Refreeze 2021-10-27 14:47:49 +02:00
1df1e7eb98 Add links to metadata yaml files 2021-10-27 14:43:10 +02:00
9592021c48 Bump version in bootstrap script 2021-10-27 14:28:32 +02:00
9a9c3b340e Remove metadata from ghcup.cabal 2021-10-27 14:02:13 +02:00
abd64cb3fa Disable darwin M1 jobs by default 2021-10-27 13:58:10 +02:00
b366a50af1 Force Cabal 3.6.2.0 2021-10-27 13:13:35 +02:00
e4b9eeefc6 Update GHC/cabal on github CI 2021-10-27 12:18:12 +02:00
4d7a8557eb Fix yaml format 2021-10-27 12:09:07 +02:00
c23357df81 Only clone when necessary 2021-10-27 12:06:24 +02:00
f728d5aa23 Revert bootstrap-haskell 2021-10-27 12:04:53 +02:00
ac59563adf Release 0.1.17.3 2021-10-27 11:56:18 +02:00
b2d2996077 Merge branch 'fix-nix' 2021-10-27 11:48:28 +02:00
df2337abf9 Get rid of nix and use homebrew, fixes #274 2021-10-27 11:48:06 +02:00
67 changed files with 598 additions and 2087 deletions

View File

@@ -44,8 +44,8 @@ jobs:
- uses: haskell/actions/setup@v1.2
with:
ghc-version: 8.10.4
cabal-version: 3.4.0.0
ghc-version: 8.10.7
cabal-version: 3.6.2.0
- name: create ~/.local/bin
run: mkdir -p "$HOME/.local/bin"

View File

@@ -11,6 +11,10 @@ variables:
# Commit of ghc/ci-images repository from which to pull Docker images
DOCKER_REV: 8d0224e6b2a08157649651e69302380b2bd24e11
# Sequential version number of all cached things.
# Bump to invalidate GitLab CI cache.
CACHE_REV: 0
############################################################
# CI Step
############################################################
@@ -164,26 +168,40 @@ variables:
- .test_ghcup_version
- .darwin:aarch64
- .root_cleanup
cache:
key: darwin-brew-$CACHE_REV
paths:
- .brew
- .brew_cache
before_script:
# Install brew locally in the project dir. Packages will also be installed here.
- '[ -e "$CI_PROJECT_DIR/.brew" ] || git clone --depth=1 https://github.com/Homebrew/brew $CI_PROJECT_DIR/.brew'
- export PATH="$CI_PROJECT_DIR/.brew/bin:$CI_PROJECT_DIR/.brew/sbin:$PATH"
# otherwise we seem to get intel binaries
- export HOMEBREW_CHANGE_ARCH_TO_ARM=1
# make sure to not pollute the machine with temp files etc
- mkdir -p $CI_PROJECT_DIR/.bc
- export HOMEBREW_CACHE=$CI_PROJECT_DIR/.bc
- mkdir -p $CI_PROJECT_DIR/.bl
- export HOMEBREW_LOGS=$CI_PROJECT_DIR/.bl
- mkdir -p $CI_PROJECT_DIR/.bt
- export HOMEBREW_TEMP=$CI_PROJECT_DIR/.bt
# update and install packages
- brew update
- brew install llvm
- brew install autoconf automake coreutils
script: |
set -Eeuo pipefail
function runInNixShell() {
time nix-shell $CI_PROJECT_DIR/.gitlab/shell.nix \
-I nixpkgs=https://github.com/angerman/nixpkgs/archive/75f7281738b.tar.gz \
--argstr system "aarch64-darwin" \
--pure \
--keep CI_PROJECT_DIR \
--keep MACOSX_DEPLOYMENT_TARGET \
--keep JSON_VERSION \
--keep ARTIFACT \
--keep OS \
--keep ARCH \
--keep CABAL_DIR \
--keep GHC_VERSION \
--keep CABAL_VERSION \
--run "$1" 2>&1
}
runInNixShell ./.gitlab/before_script/darwin/install_deps.sh 2>&1
runInNixShell ./.gitlab/script/ghcup_version.sh 2>&1
export PATH="$CI_PROJECT_DIR/.brew/opt/llvm/bin:$CI_PROJECT_DIR/.brew/bin:$CI_PROJECT_DIR/.brew/sbin:$PATH"
export CC=$CI_PROJECT_DIR/.brew/opt/llvm/bin/clang
export CXX=$CI_PROJECT_DIR/.brew/opt/llvm/bin/clang++
export LD=ld
export AR=$CI_PROJECT_DIR/.brew/opt/llvm/bin/llvm-ar
export RANLIB=$CI_PROJECT_DIR/.brew/opt/llvm/bin/llvm-ranlib
./.gitlab/before_script/darwin/install_deps.sh
./.gitlab/script/ghcup_version.sh
.test_ghcup_version:freebsd12:
extends:
@@ -388,6 +406,7 @@ test:mac:aarch64:
CABAL_VERSION: "3.6.2.0"
needs: []
allow_failure: true
when: manual
######## freebsd test ########
@@ -508,32 +527,47 @@ release:darwin:aarch64:
- .darwin:aarch64
- .release_ghcup
- .root_cleanup
cache:
key: darwin-brew-$CACHE_REV
paths:
- .brew
- .brew_cache
before_script:
# Install brew locally in the project dir. Packages will also be installed here.
- '[ -e "$CI_PROJECT_DIR/.brew" ] || git clone --depth=1 https://github.com/Homebrew/brew $CI_PROJECT_DIR/.brew'
- export PATH="$CI_PROJECT_DIR/.brew/bin:$CI_PROJECT_DIR/.brew/sbin:$PATH"
# otherwise we seem to get intel binaries
- export HOMEBREW_CHANGE_ARCH_TO_ARM=1
# make sure to not pollute the machine with temp files etc
- mkdir -p $CI_PROJECT_DIR/.bc
- export HOMEBREW_CACHE=$CI_PROJECT_DIR/.bc
- mkdir -p $CI_PROJECT_DIR/.bl
- export HOMEBREW_LOGS=$CI_PROJECT_DIR/.bl
- mkdir -p $CI_PROJECT_DIR/.bt
- export HOMEBREW_TEMP=$CI_PROJECT_DIR/.bt
# update and install packages
- brew update
- brew install llvm
- brew install autoconf automake
script: |
set -Eeuo pipefail
function runInNixShell() {
time nix-shell $CI_PROJECT_DIR/.gitlab/shell.nix \
-I nixpkgs=https://github.com/angerman/nixpkgs/archive/75f7281738b.tar.gz \
--argstr system "aarch64-darwin" \
--pure \
--keep CI_PROJECT_DIR \
--keep MACOSX_DEPLOYMENT_TARGET \
--keep JSON_VERSION \
--keep ARTIFACT \
--keep OS \
--keep ARCH \
--keep CABAL_DIR \
--keep GHC_VERSION \
--keep CABAL_VERSION \
--run "$1" 2>&1
}
runInNixShell ./.gitlab/before_script/darwin/install_deps.sh 2>&1
runInNixShell ./.gitlab/script/ghcup_release.sh 2>&1
export PATH="$CI_PROJECT_DIR/.brew/opt/llvm/bin:$CI_PROJECT_DIR/.brew/bin:$CI_PROJECT_DIR/.brew/sbin:$PATH"
export CC=$CI_PROJECT_DIR/.brew/opt/llvm/bin/clang
export CXX=$CI_PROJECT_DIR/.brew/opt/llvm/bin/clang++
export LD=ld
export AR=$CI_PROJECT_DIR/.brew/opt/llvm/bin/llvm-ar
export RANLIB=$CI_PROJECT_DIR/.brew/opt/llvm/bin/llvm-ranlib
./.gitlab/before_script/darwin/install_deps.sh
./.gitlab/script/ghcup_release.sh
variables:
ARTIFACT: "aarch64-apple-darwin-ghcup"
GHC_VERSION: "8.10.7"
CABAL_VERSION: "3.6.2.0"
MACOSX_DEPLOYMENT_TARGET: "10.7"
allow_failure: true
when: manual
######## freebsd release ########

View File

@@ -6,6 +6,6 @@ if [ "${OS}" = "WINDOWS" ] ; then
else
export GHCUP_INSTALL_BASE_PREFIX="$CI_PROJECT_DIR"
export GHCUP_BIN="$CI_PROJECT_DIR/.ghcup/bin"
export PATH="$GHCUP_BIN:$CI_PROJECT_DIR/.local/bin:/opt/llvm/bin:$PATH"
export PATH="$GHCUP_BIN:$CI_PROJECT_DIR/.local/bin:$PATH"
export TMPDIR="$CI_PROJECT_DIR/tmp"
fi

View File

@@ -85,7 +85,6 @@ else
ext=''
fi
cp "$(ecabal new-exec -w ghc-${GHC_VERSION} --verbose=0 --offline sh -- -c 'command -v ghcup')" "$CI_PROJECT_DIR"/.local/bin/ghcup${ext}
cp "$(ecabal new-exec -w ghc-${GHC_VERSION} --verbose=0 --offline sh -- -c 'command -v ghcup-gen')" "$CI_PROJECT_DIR"/.local/bin/ghcup-gen${ext}
### cleanup
@@ -94,8 +93,6 @@ rm -rf "${GHCUP_DIR}"
### manual cli based testing
ghcup-gen check -f data/metadata/ghcup-${JSON_VERSION}.yaml
eghcup --numeric-version
eghcup install ghc ${GHC_VERSION}

View File

@@ -1,90 +0,0 @@
{ system ? "aarch64-darwin"
#, nixpkgs ? fetchTarball https://github.com/angerman/nixpkgs/archive/257cb120334.tar.gz #apple-silicon.tar.gz
, pkgs ? import <nixpkgs> { inherit system; }
, compiler ? if system == "aarch64-darwin" then "ghc8103Binary" else "ghc8103"
}: pkgs.mkShell {
# this prevents nix from trying to write the env-vars file.
# we can't really, as NIX_BUILD_TOP/env-vars is not set.
noDumpEnvVars=1;
# stop polluting LDFLAGS with -liconv
dontAddExtraLibs = true;
# we need to inject ncurses into --with-curses-libraries.
# the real fix is to teach terminfo to use libcurses on macOS.
# CONFIGURE_ARGS = "--with-intree-gmp --with-curses-libraries=${pkgs.ncurses.out}/lib";
CONFIGURE_ARGS = "--with-intree-gmp --with-curses-libraries=/Library/Developer/CommandLineTools/SDKs/MacOSX.sdk/usr/lib --with-iconv-includes=/Library/Developer/CommandLineTools/SDKs/MacOSX.sdk/usr/include --with-iconv-libraries=/Library/Developer/CommandLineTools/SDKs/MacOSX.sdk/usr/lib SH=/bin/bash";
# magic speedup pony :facepalm:
#
# nix has the ugly habbit of duplicating ld flags more than necessary. This
# somewhat consolidates this.
shellHook = ''
export NIX_LDFLAGS=$(for a in $NIX_LDFLAGS; do echo $a; done |sort|uniq|xargs)
export NIX_LDFLAGS_FOR_TARGET=$(for a in $NIX_LDFLAGS_FOR_TARGET; do echo $a; done |sort|uniq|xargs)
export NIX_LDFLAGS_FOR_TARGET=$(comm -3 <(for l in $NIX_LDFLAGS_FOR_TARGET; do echo $l; done) <(for l in $NIX_LDFLAGS; do echo $l; done))
# Impurity hack for GHC releases.
#################################
# We don't want binary releases to depend on nix, thus we'll need to make sure we don't leak in references.
# GHC externally depends only on iconv and curses. However we can't force a specific curses library for
# the terminfo package, as such we'll need to make sure we only look in the system path for the curses library
# and not pick up the tinfo from the nix provided ncurses package.
#
# We also need to force us to use the systems COREFOUNDATION, not the one that nix builds. Again this is impure,
# but it will allow us to have proper binary distributions.
#
# do not use nixpkgs provided core foundation
export NIX_COREFOUNDATION_RPATH=/System/Library/Frameworks
# drop curses from the LDFLAGS, we really want the system ones, not the nix ones.
export NIX_LDFLAGS=$(for lib in $NIX_LDFLAGS; do case "$lib" in *curses*);; *) echo -n "$lib ";; esac; done;)
export NIX_CFLAGS_COMPILE+=" -Wno-nullability-completeness -Wno-availability -Wno-expansion-to-defined -Wno-builtin-requires-header -Wno-unused-command-line-argument"
# unconditionally add the MacOSX.sdk and TargetConditional.h
export NIX_CFLAGS_COMPILE+=" -isystem /Library/Developer/CommandLineTools/SDKs/MacOSX.sdk/usr/include"
export NIX_LDFLAGS="-L/Library/Developer/CommandLineTools/SDKs/MacOSX.sdk/usr/lib $NIX_LDFLAGS"
'';
nativeBuildInputs = (with pkgs; [
# This needs to come *before* ghc,
# otherwise we migth end up with the clang from
# the bootstrap GHC in PATH with higher priority.
clang_11
llvm_11
haskell.compiler.${compiler}
haskell.packages.${compiler}.cabal-install
haskell.packages.${compiler}.alex
haskell.packages.${compiler}.happy # _1_19_12 is needed for older GHCs.
automake
autoconf
m4
gmp
zlib.out
zlib.dev
glibcLocales
# locale doesn't build yet :-/
# locale
git
python3
# python3Full
# python3Packages.sphinx
perl
which
wget
curl
file
xz
xlibs.lndir
cacert ])
++ (with pkgs.darwin.apple_sdk.frameworks; [ Foundation Security ]);
}

View File

@@ -1,5 +1,12 @@
# Revision history for ghcup
## 0.1.17.3 -- 2021-10-27
* clean up during unpack failures as well
* migrate te aeson-2.0.1.0
* switch to yaml-streamly to fix performance regression wrt [#270](https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/270)
* use [github.com/haskell/ghcup-metadata](https://github.com/haskell/ghcup-metadata) for metadata file download (better caching)
## 0.1.17.2 -- 2021-09-30
* Honour GHC bootstrap compiler during git clone stages wrt [#250](https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/250)

View File

@@ -9,3 +9,5 @@
GHCup is an installer for the general purpose language [Haskell](https://www.haskell.org/).
Visit the [documentation](https://www.haskell.org/ghcup/) for installation instructions.
If you're looking for the metadata YAML files, see here: [https://github.com/haskell/ghcup-metadata](https://github.com/haskell/ghcup-metadata)

View File

@@ -1,155 +0,0 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeApplications #-}
module Main where
import GHCup.Types
import GHCup.Errors
import GHCup.Platform
import GHCup.Utils.Dirs
import GHCup.Utils.Logger
import GHCup.Types.JSON ( )
import Control.Exception ( displayException )
import Control.Monad.Trans.Reader ( runReaderT )
import Control.Monad.IO.Class
import Data.Char ( toLower )
import Data.Maybe
#if !MIN_VERSION_base(4,13,0)
import Data.Semigroup ( (<>) )
#endif
import Options.Applicative hiding ( style )
import Haskus.Utils.Variant.Excepts
import System.Console.Pretty
import System.Environment
import System.Exit
import System.IO ( stderr )
import Text.Regex.Posix
import Validate
import Text.PrettyPrint.HughesPJClass ( prettyShow )
import qualified Data.Text.IO as T
import qualified Data.Text as T
import qualified Data.ByteString as B
import qualified Data.Yaml.Aeson as Y
data Options = Options
{ optCommand :: Command
}
data Command = ValidateYAML ValidateYAMLOpts
| ValidateTarballs ValidateYAMLOpts TarballFilter
data Input
= FileInput FilePath -- optsparse-applicative doesn't handle ByteString correctly anyway
| StdInput
fileInput :: Parser Input
fileInput =
FileInput
<$> strOption
(long "file" <> short 'f' <> metavar "FILENAME" <> help
"Input file to validate"
)
stdInput :: Parser Input
stdInput = flag'
StdInput
(short 'i' <> long "stdin" <> help "Validate from stdin (default)")
inputP :: Parser Input
inputP = fileInput <|> stdInput
data ValidateYAMLOpts = ValidateYAMLOpts
{ vInput :: Maybe Input
}
validateYAMLOpts :: Parser ValidateYAMLOpts
validateYAMLOpts = ValidateYAMLOpts <$> optional inputP
tarballFilterP :: Parser TarballFilter
tarballFilterP = option readm $
long "tarball-filter" <> short 'u' <> metavar "<tool>-<version>" <> value def
<> help "Only check certain tarballs (format: <tool>-<version>)"
where
def = TarballFilter (Right Nothing) (makeRegex ("" :: String))
readm = do
s <- str
case span (/= '-') s of
(_, []) -> fail "invalid format, missing '-' after the tool name"
(t, v) | [tool] <- [ tool | tool <- [minBound..maxBound], low (show tool) == low t ] ->
pure (TarballFilter $ Right $ Just tool) <*> makeRegexOptsM compIgnoreCase execBlank (drop 1 v)
(t, v) | [tool] <- [ tool | tool <- [minBound..maxBound], low (show tool) == low t ] ->
pure (TarballFilter $ Left tool) <*> makeRegexOptsM compIgnoreCase execBlank (drop 1 v)
_ -> fail "invalid tool"
low = fmap toLower
opts :: Parser Options
opts = Options <$> com
com :: Parser Command
com = subparser
( command
"check"
( ValidateYAML
<$> info (validateYAMLOpts <**> helper)
(progDesc "Validate the YAML")
)
<> command
"check-tarballs"
(info
((ValidateTarballs <$> validateYAMLOpts <*> tarballFilterP) <**> helper)
(progDesc "Validate all tarballs (download and checksum)")
)
)
main :: IO ()
main = do
no_color <- isJust <$> lookupEnv "NO_COLOR"
let loggerConfig = LoggerConfig { lcPrintDebug = True
, consoleOutter = T.hPutStr stderr
, fileOutter = \_ -> pure ()
, fancyColors = not no_color
}
dirs <- liftIO getAllDirs
let leanAppstate = LeanAppState (Settings True False Never Curl True GHCupURL False GPGNone False) dirs defaultKeyBindings loggerConfig
pfreq <- (
flip runReaderT leanAppstate . runE @'[NoCompatiblePlatform, NoCompatibleArch, DistroNotFound] $ platformRequest
) >>= \case
VRight r -> pure r
VLeft e -> do
flip runReaderT leanAppstate $ logError $ T.pack $ prettyShow e
liftIO $ exitWith (ExitFailure 2)
let appstate = AppState (Settings True False Never Curl True GHCupURL False GPGNone False) dirs defaultKeyBindings (GHCupInfo mempty mempty mempty) pfreq loggerConfig
_ <- customExecParser (prefs showHelpOnError) (info (opts <**> helper) idm)
>>= \Options {..} -> case optCommand of
ValidateYAML vopts -> withValidateYamlOpts vopts (\dl m -> flip runReaderT appstate $ validate dl m)
ValidateTarballs vopts tarballFilter -> withValidateYamlOpts vopts (\dl m -> flip runReaderT appstate $ validateTarballs tarballFilter dl m)
pure ()
where
withValidateYamlOpts vopts f = case vopts of
ValidateYAMLOpts { vInput = Nothing } ->
B.getContents >>= valAndExit f
ValidateYAMLOpts { vInput = Just StdInput } ->
B.getContents >>= valAndExit f
ValidateYAMLOpts { vInput = Just (FileInput file) } ->
B.readFile file >>= valAndExit f
valAndExit f contents = do
(GHCupInfo _ av gt) <- case Y.decodeEither' contents of
Right r -> pure r
Left e -> die (color Red $ displayException e)
f av gt
>>= exitWith

View File

@@ -1,280 +0,0 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE OverloadedStrings #-}
module Validate where
import GHCup
import GHCup.Download
import GHCup.Errors
import GHCup.Types
import GHCup.Types.Optics
import GHCup.Utils
import GHCup.Utils.Logger
import GHCup.Utils.Version.QQ
import Codec.Archive
import Control.Applicative
import Control.Exception.Safe
import Control.Monad
import Control.Monad.IO.Class
import Control.Monad.Reader.Class
import Control.Monad.Trans.Class ( lift )
import Control.Monad.Trans.Reader ( runReaderT )
import Control.Monad.Trans.Resource ( runResourceT
, MonadUnliftIO
)
import Data.Containers.ListUtils ( nubOrd )
import Data.IORef
import Data.List
import Data.Versions
import Haskus.Utils.Variant.Excepts
import Optics
import System.FilePath
import System.Exit
import Text.ParserCombinators.ReadP
import Text.PrettyPrint.HughesPJClass ( prettyShow )
import Text.Regex.Posix
import qualified Data.Map.Strict as M
import qualified Data.Text as T
import qualified Data.Version as V
data ValidationError = InternalError String
deriving Show
instance Exception ValidationError
addError :: (MonadReader (IORef Int) m, MonadIO m, Monad m) => m ()
addError = do
ref <- ask
liftIO $ modifyIORef ref (+ 1)
validate :: (Monad m, MonadReader env m, HasLog env, MonadThrow m, MonadIO m, MonadUnliftIO m)
=> GHCupDownloads
-> M.Map GlobalTool DownloadInfo
-> m ExitCode
validate dls _ = do
ref <- liftIO $ newIORef 0
-- verify binary downloads --
flip runReaderT ref $ do
-- unique tags
forM_ (M.toList dls) $ \(t, _) -> checkUniqueTags t
-- required platforms
forM_ (M.toList dls) $ \(t, versions) ->
forM_ (M.toList versions) $ \(v, vi) ->
forM_ (M.toList $ _viArch vi) $ \(arch, pspecs) -> do
checkHasRequiredPlatforms t v (_viTags vi) arch (M.keys pspecs)
checkGHCVerIsValid
forM_ (M.toList dls) $ \(t, _) -> checkMandatoryTags t
_ <- checkGHCHasBaseVersion
-- exit
e <- liftIO $ readIORef ref
if e > 0
then pure $ ExitFailure e
else do
lift $ logInfo "All good"
pure ExitSuccess
where
checkHasRequiredPlatforms t v tags arch pspecs = do
let v' = prettyVer v
arch' = prettyShow arch
when (Linux UnknownLinux `notElem` pspecs) $ do
lift $ logError $
"Linux UnknownLinux missing for for " <> T.pack (prettyShow t) <> " " <> v' <> " " <> T.pack arch'
addError
when ((Darwin `notElem` pspecs) && arch == A_64) $ do
lift $ logError $ "Darwin missing for for " <> T.pack (prettyShow t) <> " " <> v' <> " " <> T.pack arch'
addError
when ((FreeBSD `notElem` pspecs) && arch == A_64) $ lift $ logWarn $
"FreeBSD missing for for " <> T.pack (prettyShow t) <> " " <> v' <> " " <> T.pack arch'
when (Windows `notElem` pspecs && arch == A_64) $ do
lift $ logError $ "Windows missing for for " <> T.pack (prettyShow t) <> " " <> v' <> " " <> T.pack arch'
addError
-- alpine needs to be set explicitly, because
-- we cannot assume that "Linux UnknownLinux" runs on Alpine
-- (although it could be static)
when (Linux Alpine `notElem` pspecs) $
case t of
GHCup | arch `elem` [A_64, A_32] -> lift (logError $ "Linux Alpine missing for " <> T.pack (prettyShow t) <> " " <> v' <> " " <> T.pack (prettyShow arch)) >> addError
Cabal | v > [vver|2.4.1.0|]
, arch `elem` [A_64, A_32] -> lift (logError $ "Linux Alpine missing for " <> T.pack (prettyShow t) <> " " <> v' <> " " <> T.pack (prettyShow arch)) >> addError
GHC | Latest `elem` tags || Recommended `elem` tags
, arch `elem` [A_64, A_32] -> lift (logError $ "Linux Alpine missing for " <> T.pack (prettyShow t) <> " " <> v' <> " " <> T.pack (prettyShow arch))
_ -> lift $ logWarn $ "Linux Alpine missing for " <> T.pack (prettyShow t) <> " " <> v' <> " " <> T.pack (prettyShow arch)
checkUniqueTags tool = do
let allTags = _viTags =<< M.elems (availableToolVersions dls tool)
let nonUnique =
fmap fst
. filter (\(_, b) -> not b)
<$> ( mapM
(\case
[] -> throwM $ InternalError "empty inner list"
(t : ts) ->
pure $ (t, ) (not (isUniqueTag t) || null ts)
)
. group
. sort
$ allTags
)
case join nonUnique of
[] -> pure ()
xs -> do
lift $ logError $ "Tags not unique for " <> T.pack (prettyShow tool) <> ": " <> T.pack (prettyShow xs)
addError
where
isUniqueTag Latest = True
isUniqueTag Recommended = True
isUniqueTag Old = False
isUniqueTag Prerelease = False
isUniqueTag (Base _) = False
isUniqueTag (UnknownTag _) = False
checkGHCVerIsValid = do
let ghcVers = toListOf (ix GHC % to M.keys % folded) dls
forM_ ghcVers $ \v ->
case [ x | (x,"") <- readP_to_S V.parseVersion (T.unpack . prettyVer $ v) ] of
[_] -> pure ()
_ -> do
lift $ logError $ "GHC version " <> prettyVer v <> " is not valid"
addError
-- a tool must have at least one of each mandatory tags
checkMandatoryTags tool = do
let allTags = _viTags =<< M.elems (availableToolVersions dls tool)
forM_ [Latest, Recommended] $ \t -> case t `elem` allTags of
False -> do
lift $ logError $ "Tag " <> T.pack (prettyShow t) <> " missing from " <> T.pack (prettyShow tool)
addError
True -> pure ()
-- all GHC versions must have a base tag
checkGHCHasBaseVersion = do
let allTags = M.toList $ availableToolVersions dls GHC
forM allTags $ \(ver, _viTags -> tags) -> case any isBase tags of
False -> do
lift $ logError $ "Base tag missing from GHC ver " <> prettyVer ver
addError
True -> pure ()
isBase (Base _) = True
isBase _ = False
data TarballFilter = TarballFilter
{ tfTool :: Either GlobalTool (Maybe Tool)
, tfVersion :: Regex
}
validateTarballs :: ( Monad m
, MonadReader env m
, HasLog env
, HasDirs env
, HasSettings env
, MonadThrow m
, MonadIO m
, MonadUnliftIO m
, MonadMask m
, Alternative m
, MonadFail m
)
=> TarballFilter
-> GHCupDownloads
-> M.Map GlobalTool DownloadInfo
-> m ExitCode
validateTarballs (TarballFilter etool versionRegex) dls gt = do
ref <- liftIO $ newIORef 0
-- download/verify all tarballs
let dlis = either (const []) (\tool -> nubOrd $ dls ^.. each %& indices (maybe (const True) (==) tool) %> each %& indices (matchTest versionRegex . T.unpack . prettyVer) % (viSourceDL % _Just `summing` viArch % each % each % each)) etool
let gdlis = nubOrd $ gt ^.. each
let allDls = either (const gdlis) (const dlis) etool
when (null allDls) $ logError "no tarballs selected by filter" *> runReaderT addError ref
forM_ allDls (downloadAll ref)
-- exit
e <- liftIO $ readIORef ref
if e > 0
then pure $ ExitFailure e
else do
logInfo "All good"
pure ExitSuccess
where
downloadAll :: ( MonadUnliftIO m
, MonadIO m
, MonadReader env m
, HasLog env
, HasDirs env
, HasSettings env
, MonadCatch m
, MonadMask m
, MonadThrow m
)
=> IORef Int
-> DownloadInfo
-> m ()
downloadAll ref dli = do
r <- runResourceT
. runE @'[DigestError
, GPGError
, DownloadFailed
, UnknownArchive
, ArchiveResult
]
$ do
case etool of
Right (Just GHCup) -> do
tmpUnpack <- lift mkGhcupTmpDir
_ <- liftE $ download (_dlUri dli) Nothing (Just (_dlHash dli)) tmpUnpack Nothing False
pure Nothing
Right _ -> do
p <- liftE $ downloadCached dli Nothing
fmap (Just . head . splitDirectories . head)
. liftE
. getArchiveFiles
$ p
Left ShimGen -> do
tmpUnpack <- lift mkGhcupTmpDir
_ <- liftE $ download (_dlUri dli) Nothing (Just (_dlHash dli)) tmpUnpack Nothing False
pure Nothing
case r of
VRight (Just basePath) -> do
case _dlSubdir dli of
Just (RealDir prel) -> do
logInfo
$ " verifying subdir: " <> T.pack prel
when (basePath /= prel) $ do
logError $
"Subdir doesn't match: expected " <> T.pack prel <> ", got " <> T.pack basePath
runReaderT addError ref
Just (RegexDir regexString) -> do
logInfo $
"verifying subdir (regex): " <> T.pack regexString
let regex = makeRegexOpts
compIgnoreCase
execBlank
regexString
unless (match regex basePath) $ do
logError $
"Subdir doesn't match: expected regex " <> T.pack regexString <> ", got " <> T.pack basePath
runReaderT addError ref
Nothing -> pure ()
VRight Nothing -> pure ()
VLeft e -> do
logError $
"Could not download (or verify hash) of " <> T.pack (show dli) <> ", Error was: " <> T.pack (prettyShow e)
runReaderT addError ref

View File

@@ -10,11 +10,12 @@ module BrickMain where
import GHCup
import GHCup.Download
import GHCup.Errors
import GHCup.Types.Optics ( getDirs )
import GHCup.Types hiding ( LeanAppState(..) )
import GHCup.Utils
import GHCup.Utils.Logger
import GHCup.Utils.Prelude ( decUTF8Safe )
import GHCup.Utils.File
import GHCup.Logger
import GHCup.Prelude ( decUTF8Safe )
import GHCup.System.Process
import Brick
import Brick.Widgets.Border
@@ -26,6 +27,9 @@ import Brick.Widgets.List ( listSelectedFocusedAttr
)
import Codec.Archive
import Control.Exception.Safe
#if !MIN_VERSION_base(4,13,0)
import Control.Monad.Fail ( MonadFail )
#endif
import Control.Monad.Reader
import Control.Monad.Trans.Except
import Control.Monad.Trans.Resource
@@ -40,6 +44,8 @@ import Data.Vector ( Vector
import Data.Versions hiding ( str )
import Haskus.Utils.Variant.Excepts
import Prelude hiding ( appendFile )
import System.Directory ( canonicalizePath )
import System.FilePath
import System.Exit
import System.IO.Unsafe
import Text.PrettyPrint.HughesPJClass ( prettyShow )
@@ -48,6 +54,8 @@ import URI.ByteString
import qualified Data.Text as T
import qualified Graphics.Vty as Vty
import qualified Data.Vector as V
import System.Environment (getExecutablePath)
import qualified System.Posix.Process as SPP
hiddenTools :: [Tool]
@@ -432,27 +440,42 @@ install' _ (_, ListResult {..}) = do
]
run (do
ce <- liftIO $ fmap (either (const Nothing) Just) $
try @_ @SomeException $ getExecutablePath >>= canonicalizePath
dirs <- lift getDirs
case lTool of
GHC -> do
let vi = getVersionInfo lVer GHC dls
liftE $ installGHCBin lVer Nothing False $> vi
liftE $ installGHCBin lVer Nothing False $> (vi, dirs, ce)
Cabal -> do
let vi = getVersionInfo lVer Cabal dls
liftE $ installCabalBin lVer Nothing False $> vi
liftE $ installCabalBin lVer Nothing False $> (vi, dirs, ce)
GHCup -> do
let vi = snd <$> getLatest dls GHCup
liftE $ upgradeGHCup Nothing False $> vi
liftE $ upgradeGHCup Nothing False $> (vi, dirs, ce)
HLS -> do
let vi = getVersionInfo lVer HLS dls
liftE $ installHLSBin lVer Nothing False $> vi
liftE $ installHLSBin lVer Nothing False $> (vi, dirs, ce)
Stack -> do
let vi = getVersionInfo lVer Stack dls
liftE $ installStackBin lVer Nothing False $> vi
liftE $ installStackBin lVer Nothing False $> (vi, dirs, ce)
)
>>= \case
VRight vi -> do
forM_ (_viPostInstall =<< vi) $ \msg ->
logInfo msg
VRight (vi, Dirs{..}, Just ce) -> do
forM_ (_viPostInstall =<< vi) $ \msg -> logInfo msg
case lTool of
GHCup -> do
up <- liftIO $ fmap (either (const Nothing) Just)
$ try @_ @SomeException $ canonicalizePath (binDir </> "ghcup" <.> exeExt)
when ((normalise <$> up) == Just (normalise ce)) $
-- TODO: track cli arguments of previous invocation
liftIO $ SPP.executeFile ce False ["tui"] Nothing
logInfo "Please restart 'ghcup' for the changes to take effect"
_ -> pure ()
pure $ Right ()
VRight (vi, _, _) -> do
forM_ (_viPostInstall =<< vi) $ \msg -> logInfo msg
logInfo "Please restart 'ghcup' for the changes to take effect"
pure $ Right ()
VLeft (V (AlreadyInstalled _ _)) -> pure $ Right ()
VLeft (V NoUpdate) -> pure $ Right ()
@@ -536,17 +559,7 @@ settings' = unsafePerformIO $ do
, fileOutter = \_ -> pure ()
, fancyColors = True
}
newIORef $ AppState (Settings { cache = True
, noVerify = False
, keepDirs = Never
, downloader = Curl
, verbose = False
, urlSource = GHCupURL
, noNetwork = False
, gpgSetting = GPGNone
, noColor = False
, ..
})
newIORef $ AppState defaultSettings
dirs
defaultKeyBindings
(GHCupInfo mempty mempty mempty)
@@ -605,4 +618,3 @@ getAppData mgi = runExceptT $ do
flip runReaderT settings $ do
lV <- listVersions Nothing Nothing
pure $ BrickData (reverse lV)

View File

@@ -67,6 +67,7 @@ data Options = Options
-- global options
optVerbose :: Maybe Bool
, optCache :: Maybe Bool
, optMetaCache :: Maybe Integer
, optUrlSource :: Maybe URI
, optNoVerify :: Maybe Bool
, optKeepDirs :: Maybe KeepDirs
@@ -105,6 +106,7 @@ opts =
Options
<$> invertableSwitch "verbose" 'v' False (help "Enable verbosity (default: disabled)")
<*> invertableSwitch "cache" 'c' False (help "Cache downloads in ~/.ghcup/cache (default: disabled)")
<*> optional (option auto (long "metadata-caching" <> help "How long the yaml metadata caching interval is (in seconds), 0 to disable" <> internal))
<*> optional
(option
(eitherReader parseUri)

View File

@@ -12,9 +12,9 @@ module GHCup.OptParse.ChangeLog where
import GHCup.Types
import GHCup.Utils.Logger
import GHCup.Logger
import GHCup.OptParse.Common
import GHCup.Utils.String.QQ
import GHCup.QQ.String
#if !MIN_VERSION_base(4,13,0)
import Control.Monad.Fail ( MonadFail )
@@ -34,8 +34,8 @@ import GHCup.Types.Optics
import GHCup.Utils
import Data.Versions
import URI.ByteString (serializeURIRef')
import GHCup.Utils.Prelude
import GHCup.Utils.File (exec)
import GHCup.Prelude
import GHCup.System.Process (exec)
import Data.Char (toLower)

View File

@@ -14,9 +14,9 @@ import GHCup.Platform
import GHCup.Types
import GHCup.Types.Optics
import GHCup.Utils
import GHCup.Utils.Logger
import GHCup.Utils.MegaParsec
import GHCup.Utils.Prelude
import GHCup.Logger
import GHCup.MegaParsec
import GHCup.Prelude
import Control.Exception.Safe
#if !MIN_VERSION_base(4,13,0)
@@ -299,7 +299,7 @@ tagCompleter tool add = listIOCompleter $ do
, fancyColors = False
}
let appState = LeanAppState
(Settings True False Never Curl False GHCupURL True GPGNone False)
(defaultSettings { noNetwork = True })
dirs'
defaultKeyBindings
loggerConfig
@@ -322,7 +322,7 @@ versionCompleter criteria tool = listIOCompleter $ do
, fileOutter = mempty
, fancyColors = False
}
let settings = Settings True False Never Curl False GHCupURL True GPGNone False
let settings = defaultSettings { noNetwork = True }
let leanAppState = LeanAppState
settings
dirs'
@@ -399,7 +399,7 @@ fromVersion' (SetToolVersion v) tool = do
Right pvpIn ->
lift (getLatestToolFor tool pvpIn dls) >>= \case
Just (pvp_, vi') -> do
v' <- lift $ pvpToVersion pvp_
v' <- lift $ pvpToVersion pvp_ ""
when (v' /= _tvVersion v) $ lift $ logWarn ("Assuming you meant version " <> prettyVer v')
pure (GHCTargetVersion (_tvTarget v) v', Just vi')
Nothing -> pure (v, vi)

View File

@@ -13,13 +13,13 @@ module GHCup.OptParse.Compile where
import GHCup
import GHCup.Errors
import GHCup.Utils.File
import GHCup.Types
import GHCup.Types.Optics
import GHCup.Utils
import GHCup.Utils.Logger
import GHCup.Logger
import GHCup.OptParse.Common
import GHCup.Utils.String.QQ
import GHCup.QQ.String
import GHCup.System.Process
#if !MIN_VERSION_base(4,13,0)
import Control.Monad.Fail ( MonadFail )

View File

@@ -14,9 +14,9 @@ module GHCup.OptParse.Config where
import GHCup.Errors
import GHCup.Types
import GHCup.Utils
import GHCup.Utils.Prelude
import GHCup.Utils.Logger
import GHCup.Utils.String.QQ
import GHCup.Prelude
import GHCup.Logger
import GHCup.QQ.String
#if !MIN_VERSION_base(4,13,0)
import Control.Monad.Fail ( MonadFail )
@@ -122,6 +122,7 @@ updateSettings config' settings = do
mergeConf :: UserSettings -> Settings -> Settings
mergeConf UserSettings{..} Settings{..} =
let cache' = fromMaybe cache uCache
metaCache' = fromMaybe metaCache uMetaCache
noVerify' = fromMaybe noVerify uNoVerify
keepDirs' = fromMaybe keepDirs uKeepDirs
downloader' = fromMaybe downloader uDownloader
@@ -129,7 +130,7 @@ updateSettings config' settings = do
urlSource' = fromMaybe urlSource uUrlSource
noNetwork' = fromMaybe noNetwork uNoNetwork
gpgSetting' = fromMaybe gpgSetting uGPGSetting
in Settings cache' noVerify' keepDirs' downloader' verbose' urlSource' noNetwork' gpgSetting' noColor
in Settings cache' metaCache' noVerify' keepDirs' downloader' verbose' urlSource' noNetwork' gpgSetting' noColor

View File

@@ -17,9 +17,10 @@ import GHCup
import GHCup.Errors
import GHCup.Version
import GHCup.Types
import GHCup.Utils.Prelude
import GHCup.Utils.Dirs
import GHCup.Utils.Logger
import GHCup.Prelude
import GHCup.Directories
import GHCup.Logger
import GHCup.System.Process
#if !MIN_VERSION_base(4,13,0)
import Control.Monad.Fail ( MonadFail )
@@ -36,7 +37,6 @@ import Text.PrettyPrint.HughesPJClass ( prettyShow )
import qualified Data.Text as T
import Control.Exception.Safe (MonadMask)
import GHCup.Utils.File
import Language.Haskell.TH
@@ -51,7 +51,7 @@ describe_result = $( LitE . StringL <$>
runIO (do
CapturedProcess{..} <- do
dirs <- liftIO getAllDirs
let settings = AppState (Settings True False Never Curl False GHCupURL False GPGNone False)
let settings = AppState (defaultSettings { noNetwork = True })
dirs
defaultKeyBindings
flip runReaderT settings $ executeOut "git" ["describe"] Nothing

View File

@@ -14,8 +14,8 @@ module GHCup.OptParse.GC where
import GHCup
import GHCup.Errors
import GHCup.Types
import GHCup.Utils.Logger
import GHCup.Utils.String.QQ
import GHCup.Logger
import GHCup.QQ.String
#if !MIN_VERSION_base(4,13,0)
import Control.Monad.Fail ( MonadFail )

View File

@@ -17,9 +17,9 @@ import GHCup.OptParse.Common
import GHCup
import GHCup.Errors
import GHCup.Types
import GHCup.Utils.File
import GHCup.Utils.Logger
import GHCup.Utils.String.QQ
import GHCup.Logger
import GHCup.QQ.String
import GHCup.System.Process
import Codec.Archive
#if !MIN_VERSION_base(4,13,0)

View File

@@ -11,7 +11,7 @@ module GHCup.OptParse.List where
import GHCup
import GHCup.Utils.Prelude
import GHCup.Prelude
import GHCup.Types
import GHCup.OptParse.Common

View File

@@ -14,7 +14,7 @@ module GHCup.OptParse.Nuke where
import GHCup
import GHCup.Errors
import GHCup.Types
import GHCup.Utils.Logger
import GHCup.Logger
#if !MIN_VERSION_base(4,13,0)
import Control.Monad.Fail ( MonadFail )

View File

@@ -14,9 +14,9 @@ module GHCup.OptParse.Prefetch where
import GHCup
import GHCup.Errors
import GHCup.Types
import GHCup.Utils.Logger
import GHCup.Logger
import GHCup.OptParse.Common
import GHCup.Utils.String.QQ
import GHCup.QQ.String
#if !MIN_VERSION_base(4,13,0)
import Control.Monad.Fail ( MonadFail )
@@ -33,7 +33,7 @@ import Text.PrettyPrint.HughesPJClass ( prettyShow )
import qualified Data.Text as T
import Control.Exception.Safe (MonadMask)
import GHCup.Utils.Prelude
import GHCup.Prelude
import GHCup.Download (getDownloadsF)

View File

@@ -18,9 +18,9 @@ import GHCup.Errors
import GHCup.Types
import GHCup.Types.Optics
import GHCup.Utils
import GHCup.Utils.Logger
import GHCup.Logger
import GHCup.OptParse.Common
import GHCup.Utils.String.QQ
import GHCup.QQ.String
#if !MIN_VERSION_base(4,13,0)
import Control.Monad.Fail ( MonadFail )

View File

@@ -17,8 +17,8 @@ import GHCup.OptParse.Common
import GHCup
import GHCup.Errors
import GHCup.Types
import GHCup.Utils.Logger
import GHCup.Utils.String.QQ
import GHCup.Logger
import GHCup.QQ.String
#if !MIN_VERSION_base(4,13,0)
import Control.Monad.Fail ( MonadFail )

View File

@@ -10,7 +10,7 @@ module GHCup.OptParse.ToolRequirements where
import GHCup.Errors
import GHCup.Types
import GHCup.Utils.Logger
import GHCup.Logger
#if !MIN_VERSION_base(4,13,0)
import Control.Monad.Fail ( MonadFail )
@@ -28,7 +28,7 @@ import qualified Data.Text.IO as T
import Control.Exception.Safe (MonadMask)
import GHCup.Types.Optics
import GHCup.Platform
import GHCup.Utils.Prelude
import GHCup.Prelude
import GHCup.Requirements
import System.IO

View File

@@ -16,8 +16,8 @@ module GHCup.OptParse.UnSet where
import GHCup
import GHCup.Errors
import GHCup.Types
import GHCup.Utils.Logger
import GHCup.Utils.String.QQ
import GHCup.Logger
import GHCup.QQ.String
#if !MIN_VERSION_base(4,13,0)
import Control.Monad.Fail ( MonadFail )

View File

@@ -14,7 +14,7 @@ module GHCup.OptParse.Upgrade where
import GHCup
import GHCup.Errors
import GHCup.Types
import GHCup.Utils.Logger
import GHCup.Logger
#if !MIN_VERSION_base(4,13,0)
import Control.Monad.Fail ( MonadFail )

View File

@@ -17,8 +17,8 @@ import GHCup
import GHCup.Errors
import GHCup.OptParse.Common
import GHCup.Types
import GHCup.Utils.Logger
import GHCup.Utils.String.QQ
import GHCup.Logger
import GHCup.QQ.String
#if !MIN_VERSION_base(4,13,0)
import Control.Monad.Fail ( MonadFail )

View File

@@ -21,9 +21,9 @@ import GHCup.Errors
import GHCup.Platform
import GHCup.Types
import GHCup.Utils
import GHCup.Utils.Logger
import GHCup.Utils.Prelude
import GHCup.Utils.String.QQ
import GHCup.Logger
import GHCup.Prelude
import GHCup.QQ.String
import GHCup.Version
import Cabal.Plan ( findPlanJson, SearchPlanJson(..) )
@@ -55,6 +55,7 @@ import qualified Data.ByteString as B
import qualified Data.Text as T
import qualified Data.Text.IO as T
import qualified Data.Text.Encoding as E
import qualified GHCup.Types as Types
@@ -72,15 +73,16 @@ toSettings options = do
where
mergeConf :: Options -> UserSettings -> Bool -> (Settings, KeyBindings)
mergeConf Options{..} UserSettings{..} noColor =
let cache = fromMaybe (fromMaybe False uCache) optCache
noVerify = fromMaybe (fromMaybe False uNoVerify) optNoVerify
verbose = fromMaybe (fromMaybe False uVerbose) optVerbose
keepDirs = fromMaybe (fromMaybe Errors uKeepDirs) optKeepDirs
let cache = fromMaybe (fromMaybe (Types.cache defaultSettings) uCache) optCache
metaCache = fromMaybe (fromMaybe (Types.metaCache defaultSettings) uMetaCache) optMetaCache
noVerify = fromMaybe (fromMaybe (Types.noVerify defaultSettings) uNoVerify) optNoVerify
verbose = fromMaybe (fromMaybe (Types.verbose defaultSettings) uVerbose) optVerbose
keepDirs = fromMaybe (fromMaybe (Types.keepDirs defaultSettings) uKeepDirs) optKeepDirs
downloader = fromMaybe (fromMaybe defaultDownloader uDownloader) optsDownloader
keyBindings = maybe defaultKeyBindings mergeKeys uKeyBindings
urlSource = maybe (fromMaybe GHCupURL uUrlSource) OwnSource optUrlSource
noNetwork = fromMaybe (fromMaybe False uNoNetwork) optNoNetwork
gpgSetting = fromMaybe (fromMaybe GPGNone uGPGSetting) optGpg
urlSource = maybe (fromMaybe (Types.urlSource defaultSettings) uUrlSource) OwnSource optUrlSource
noNetwork = fromMaybe (fromMaybe (Types.noNetwork defaultSettings) uNoNetwork) optNoNetwork
gpgSetting = fromMaybe (fromMaybe (Types.gpgSetting defaultSettings) uGPGSetting) optGpg
in (Settings {..}, keyBindings)
#if defined(INTERNAL_DOWNLOADER)
defaultDownloader = Internal

View File

@@ -8,7 +8,9 @@ package ghcup
tests: True
flags: +tui
constraints: http-io-streams -brotli
constraints: http-io-streams -brotli,
any.Cabal ==3.6.2.0,
any.aeson >= 2.0.1.0
package libarchive
flags: -system-libarchive
@@ -19,6 +21,9 @@ package aeson-pretty
package cabal-plan
flags: -exe
package aeson
flags: +ordered-keymap
allow-newer: base, ghc-prim, template-haskell, language-c
with-compiler: ghc-8.10.7

View File

@@ -1,18 +1,17 @@
active-repositories: hackage.haskell.org:merge
constraints: any.Cabal ==3.2.1.0 || ==3.6.1.0,
constraints: any.Cabal ==3.6.2.0,
Cabal -bundled-binary-generic,
any.HUnit ==1.6.2.0,
any.HsOpenSSL ==0.11.7.2,
HsOpenSSL -fast-bignum -homebrew-openssl -macports-openssl -use-pkg-config,
any.HsYAML ==0.2.1.0,
HsYAML -exe,
any.HsYAML-aeson ==0.2.0.0,
any.QuickCheck ==2.14.2,
QuickCheck -old-random +templatehaskell,
any.StateVar ==1.2.2,
any.aeson ==1.5.6.0,
aeson -bytestring-builder -cffi -developer -fast,
any.aeson-pretty ==0.8.8,
any.abstract-deque ==0.3,
abstract-deque -usecas,
any.aeson ==2.0.1.0,
aeson -bytestring-builder -cffi +ordered-keymap,
any.aeson-pretty ==0.8.9,
aeson-pretty +lib-only,
any.alex ==3.2.6,
alex +small_base,
@@ -22,8 +21,10 @@ constraints: any.Cabal ==3.2.1.0 || ==3.6.1.0,
ansi-wl-pprint -example,
any.array ==0.5.4.0,
any.assoc ==1.0.2,
any.async ==2.2.3,
any.async ==2.2.4,
async -bench,
any.atomic-primops ==0.8.4,
atomic-primops -debug,
any.attoparsec ==0.13.2.5,
attoparsec -developer,
any.base ==4.14.3.0,
@@ -35,15 +36,15 @@ constraints: any.Cabal ==3.2.1.0 || ==3.6.1.0,
any.bifunctors ==5.5.11,
bifunctors +semigroups +tagged,
any.binary ==0.8.8.0,
any.blaze-builder ==0.4.2.1,
any.brick ==0.64.1,
any.blaze-builder ==0.4.2.2,
any.brick ==0.64.2,
brick -demos,
any.bytestring ==0.10.12.0,
any.bz2 ==1.0.1.0,
bz2 -cross +with-bzlib,
any.c2hs ==0.28.8,
c2hs +base3 -regression,
any.cabal-plan ==0.7.2.0,
any.cabal-plan ==0.7.2.1,
cabal-plan -_ -exe -license-report,
any.call-stack ==0.4.0,
any.case-insensitive ==1.2.1.0,
@@ -66,7 +67,7 @@ constraints: any.Cabal ==3.2.1.0 || ==3.6.1.0,
any.cpphs ==1.20.9.1,
cpphs -old-locale,
any.cryptohash-sha1 ==0.11.100.1,
any.cryptohash-sha256 ==0.11.102.0,
any.cryptohash-sha256 ==0.11.102.1,
cryptohash-sha256 -exe +use-cbits,
any.data-clist ==0.1.2.3,
any.data-fix ==0.3.2,
@@ -80,16 +81,18 @@ constraints: any.Cabal ==3.2.1.0 || ==3.6.1.0,
any.exceptions ==0.10.4,
any.filepath ==1.4.2.1,
any.free ==5.1.7,
any.fusion-plugin-types ==0.1.0,
any.generic-arbitrary ==0.1.0,
any.ghc-boot-th ==8.10.7,
any.ghc-byteorder ==4.11.0.0.10,
any.ghc-prim ==0.6.1,
any.happy ==1.20.0,
any.hashable ==1.3.3.0,
any.hashable ==1.3.4.1,
hashable +integer-gmp -random-initial-seed,
any.haskus-utils-data ==1.4,
any.haskus-utils-types ==1.5.1,
any.haskus-utils-variant ==3.1,
any.heaps ==0.4,
any.hsc2hs ==0.68.7,
hsc2hs -in-ghc-tree,
any.hspec ==2.7.10,
@@ -109,16 +112,20 @@ constraints: any.Cabal ==3.2.1.0 || ==3.6.1.0,
io-streams +network -nointeractivetests +zlib,
any.language-c ==0.9.0.1,
language-c -allwarnings +iecfpextension +usebytestrings,
any.libarchive ==3.0.3.0,
any.libarchive ==3.0.3.1,
libarchive -cross -low-memory -system-libarchive,
any.libyaml-streamly ==0.2.0,
libyaml-streamly -no-unicode -system-libyaml,
any.lockfree-queue ==0.2.3.1,
any.lzma-static ==5.2.5.4,
any.megaparsec ==9.0.1,
megaparsec -dev,
any.microlens ==0.4.12.0,
any.microlens-mtl ==0.2.0.1,
any.microlens-th ==0.4.3.10,
any.monad-control ==1.0.3.1,
any.mtl ==2.2.2,
any.network ==3.1.2.2,
any.network ==3.1.2.5,
network -devel,
any.network-uri ==2.6.4.1,
any.openssl-streams ==1.2.3.0,
@@ -129,7 +136,7 @@ constraints: any.Cabal ==3.2.1.0 || ==3.6.1.0,
any.optics-th ==0.4,
any.optparse-applicative ==0.16.1.0,
optparse-applicative +process,
any.os-release ==1.0.2,
any.os-release ==1.0.2.1,
os-release -devel,
any.parallel ==3.2.2.0,
any.parsec ==3.1.14.0,
@@ -150,18 +157,24 @@ constraints: any.Cabal ==3.2.1.0 || ==3.6.1.0,
any.regex-posix ==0.96.0.1,
regex-posix -_regex-posix-clib,
any.resourcet ==1.2.4.3,
any.retry ==0.8.1.2,
retry -lib-werror,
any.rts ==1.0.1,
any.safe ==0.3.19,
any.safe-exceptions ==0.1.7.2,
any.scientific ==0.3.7.0,
scientific -bytestring-builder -integer-simple,
any.semigroupoids ==5.3.5,
any.semialign ==1.2,
semialign +semigroupoids,
any.semigroupoids ==5.3.6,
semigroupoids +comonad +containers +contravariant +distributive +tagged +unordered-containers,
any.setenv ==0.1.1.3,
any.split ==0.2.3.4,
any.splitmix ==0.1.0.3,
splitmix -optimised-mixer,
any.stm ==2.5.0.1,
any.streamly ==0.8.0,
streamly -debug -dev -fusion-plugin -has-llvm -inspection -no-fusion +opt -streamk -use-c-malloc,
any.strict ==0.4.0.1,
strict +assoc,
any.strict-base ==0.4.0.0,
@@ -190,7 +203,7 @@ constraints: any.Cabal ==3.2.1.0 || ==3.6.1.0,
any.transformers-compat ==0.7,
transformers-compat -five +five-three -four +generic-deriving +mtl -three -two,
any.unix ==2.7.2.2,
any.unix-bytestring ==0.3.7.3,
any.unix-bytestring ==0.3.7.5,
any.unix-compat ==0.5.3,
unix-compat -old-time,
any.unliftio-core ==0.2.0.1,
@@ -204,10 +217,13 @@ constraints: any.Cabal ==3.2.1.0 || ==3.6.1.0,
vector +boundschecks -internalchecks -unsafechecks -wall,
any.versions ==5.0.0,
any.vty ==5.33,
any.witherable ==0.4.2,
any.word-wrap ==0.5,
any.word8 ==0.1.3,
any.xor ==0.0.1.0,
any.yaml-streamly ==0.12.0,
yaml-streamly +no-examples +no-exe,
any.zlib ==0.6.2.3,
zlib -bundled-c-zlib -non-blocking-ffi -pkg-config,
any.zlib-bindings ==0.1.1.5
index-state: hackage.haskell.org 2021-10-01T15:16:26Z
index-state: hackage.haskell.org 2021-10-24T10:21:56Z

View File

@@ -8,7 +8,9 @@ package ghcup
tests: True
flags: +tui
constraints: http-io-streams -brotli
constraints: http-io-streams -brotli,
any.Cabal ==3.6.2.0,
any.aeson >= 2.0.1.0
package libarchive
flags: -system-libarchive
@@ -19,6 +21,9 @@ package aeson-pretty
package cabal-plan
flags: -exe
package aeson
flags: +ordered-keymap
allow-newer: base, ghc-prim, template-haskell, language-c
with-compiler: ghc-9.0.1

View File

@@ -1,18 +1,17 @@
active-repositories: hackage.haskell.org:merge
constraints: any.Cabal ==3.4.0.0 || ==3.6.1.0,
constraints: any.Cabal ==3.6.2.0,
Cabal -bundled-binary-generic,
any.HUnit ==1.6.2.0,
any.HsOpenSSL ==0.11.7.2,
HsOpenSSL -fast-bignum -homebrew-openssl -macports-openssl -use-pkg-config,
any.HsYAML ==0.2.1.0,
HsYAML -exe,
any.HsYAML-aeson ==0.2.0.0,
any.QuickCheck ==2.14.2,
QuickCheck -old-random +templatehaskell,
any.StateVar ==1.2.2,
any.aeson ==1.5.6.0,
aeson -bytestring-builder -cffi -developer -fast,
any.aeson-pretty ==0.8.8,
any.abstract-deque ==0.3,
abstract-deque -usecas,
any.aeson ==2.0.1.0,
aeson -bytestring-builder -cffi +ordered-keymap,
any.aeson-pretty ==0.8.9,
aeson-pretty +lib-only,
any.alex ==3.2.6,
alex +small_base,
@@ -22,8 +21,10 @@ constraints: any.Cabal ==3.4.0.0 || ==3.6.1.0,
ansi-wl-pprint -example,
any.array ==0.5.4.0,
any.assoc ==1.0.2,
any.async ==2.2.3,
any.async ==2.2.4,
async -bench,
any.atomic-primops ==0.8.4,
atomic-primops -debug,
any.attoparsec ==0.13.2.5,
attoparsec -developer,
any.base ==4.15.0.0,
@@ -35,15 +36,15 @@ constraints: any.Cabal ==3.4.0.0 || ==3.6.1.0,
any.bifunctors ==5.5.11,
bifunctors +semigroups +tagged,
any.binary ==0.8.8.0,
any.blaze-builder ==0.4.2.1,
any.brick ==0.64.1,
any.blaze-builder ==0.4.2.2,
any.brick ==0.64.2,
brick -demos,
any.bytestring ==0.10.12.1,
any.bz2 ==1.0.1.0,
bz2 -cross +with-bzlib,
any.c2hs ==0.28.8,
c2hs +base3 -regression,
any.cabal-plan ==0.7.2.0,
any.cabal-plan ==0.7.2.1,
cabal-plan -_ -exe -license-report,
any.call-stack ==0.4.0,
any.case-insensitive ==1.2.1.0,
@@ -66,7 +67,7 @@ constraints: any.Cabal ==3.4.0.0 || ==3.6.1.0,
any.cpphs ==1.20.9.1,
cpphs -old-locale,
any.cryptohash-sha1 ==0.11.100.1,
any.cryptohash-sha256 ==0.11.102.0,
any.cryptohash-sha256 ==0.11.102.1,
cryptohash-sha256 -exe +use-cbits,
any.data-clist ==0.1.2.3,
any.data-fix ==0.3.2,
@@ -80,17 +81,19 @@ constraints: any.Cabal ==3.4.0.0 || ==3.6.1.0,
any.exceptions ==0.10.4,
any.filepath ==1.4.2.1,
any.free ==5.1.7,
any.fusion-plugin-types ==0.1.0,
any.generic-arbitrary ==0.1.0,
any.ghc-bignum ==1.0,
any.ghc-boot-th ==9.0.1,
any.ghc-byteorder ==4.11.0.0.10,
any.ghc-prim ==0.7.0,
any.happy ==1.20.0,
any.hashable ==1.3.3.0,
any.hashable ==1.3.4.1,
hashable +integer-gmp -random-initial-seed,
any.haskus-utils-data ==1.4,
any.haskus-utils-types ==1.5.1,
any.haskus-utils-variant ==3.1,
any.heaps ==0.4,
any.hsc2hs ==0.68.7,
hsc2hs -in-ghc-tree,
any.hspec ==2.7.10,
@@ -109,16 +112,20 @@ constraints: any.Cabal ==3.4.0.0 || ==3.6.1.0,
io-streams +network -nointeractivetests +zlib,
any.language-c ==0.9.0.1,
language-c -allwarnings +iecfpextension +usebytestrings,
any.libarchive ==3.0.3.0,
any.libarchive ==3.0.3.1,
libarchive -cross -low-memory -system-libarchive,
any.libyaml-streamly ==0.2.0,
libyaml-streamly -no-unicode -system-libyaml,
any.lockfree-queue ==0.2.3.1,
any.lzma-static ==5.2.5.4,
any.megaparsec ==9.0.1,
megaparsec -dev,
any.microlens ==0.4.12.0,
any.microlens-mtl ==0.2.0.1,
any.microlens-th ==0.4.3.10,
any.monad-control ==1.0.3.1,
any.mtl ==2.2.2,
any.network ==3.1.2.2,
any.network ==3.1.2.5,
network -devel,
any.network-uri ==2.6.4.1,
any.openssl-streams ==1.2.3.0,
@@ -129,7 +136,7 @@ constraints: any.Cabal ==3.4.0.0 || ==3.6.1.0,
any.optics-th ==0.4,
any.optparse-applicative ==0.16.1.0,
optparse-applicative +process,
any.os-release ==1.0.2,
any.os-release ==1.0.2.1,
os-release -devel,
any.parallel ==3.2.2.0,
any.parsec ==3.1.14.0,
@@ -150,18 +157,24 @@ constraints: any.Cabal ==3.4.0.0 || ==3.6.1.0,
any.regex-posix ==0.96.0.1,
regex-posix -_regex-posix-clib,
any.resourcet ==1.2.4.3,
any.retry ==0.8.1.2,
retry -lib-werror,
any.rts ==1.0,
any.safe ==0.3.19,
any.safe-exceptions ==0.1.7.2,
any.scientific ==0.3.7.0,
scientific -bytestring-builder -integer-simple,
any.semigroupoids ==5.3.5,
any.semialign ==1.2,
semialign +semigroupoids,
any.semigroupoids ==5.3.6,
semigroupoids +comonad +containers +contravariant +distributive +tagged +unordered-containers,
any.setenv ==0.1.1.3,
any.split ==0.2.3.4,
any.splitmix ==0.1.0.3,
splitmix -optimised-mixer,
any.stm ==2.5.0.0,
any.streamly ==0.8.0,
streamly -debug -dev -fusion-plugin -has-llvm -inspection -no-fusion +opt -streamk -use-c-malloc,
any.strict ==0.4.0.1,
strict +assoc,
any.strict-base ==0.4.0.0,
@@ -190,7 +203,7 @@ constraints: any.Cabal ==3.4.0.0 || ==3.6.1.0,
any.transformers-compat ==0.7,
transformers-compat -five +five-three -four +generic-deriving +mtl -three -two,
any.unix ==2.7.2.2,
any.unix-bytestring ==0.3.7.3,
any.unix-bytestring ==0.3.7.5,
any.unix-compat ==0.5.3,
unix-compat -old-time,
any.unliftio-core ==0.2.0.1,
@@ -204,10 +217,13 @@ constraints: any.Cabal ==3.4.0.0 || ==3.6.1.0,
vector +boundschecks -internalchecks -unsafechecks -wall,
any.versions ==5.0.0,
any.vty ==5.33,
any.witherable ==0.4.2,
any.word-wrap ==0.5,
any.word8 ==0.1.3,
any.xor ==0.0.1.0,
any.yaml-streamly ==0.12.0,
yaml-streamly +no-examples +no-exe,
any.zlib ==0.6.2.3,
zlib -bundled-c-zlib -non-blocking-ffi -pkg-config,
any.zlib-bindings ==0.1.1.5
index-state: hackage.haskell.org 2021-10-01T15:16:26Z
index-state: hackage.haskell.org 2021-10-24T10:21:56Z

View File

@@ -9,9 +9,14 @@ package ghcup
flags: +tui
constraints: http-io-streams -brotli,
any.Cabal ==3.4.1.0 || ==3.6.2.0,
any.Cabal ==3.6.2.0,
any.aeson >= 2.0.1.0
source-repository-package
type: git
location: https://github.com/input-output-hk/optparse-applicative
tag: 7497a29cb998721a9068d5725d49461f2bba0e7a
package libarchive
flags: -system-libarchive

View File

@@ -36,6 +36,10 @@ key-bindings:
show-all-tools:
KChar: 't'
# The caching for the metadata files containing download info, depending on last access time
# of the file. These usually are in '~/.ghcup/cache/ghcup-<ver>.yaml'.
meta-cache: 300 # in seconds
# Where to get GHC/cabal/hls download info/versions from. For more detailed explanation
# check the 'URLSource' type in the code.
url-source:

View File

@@ -95,21 +95,19 @@ Every subcommand now lives in its own module under [GHCup.OptParse.MyCommand](ht
3. Add ChangeLog entry
4. Add/fix downloads in `ghcup-<ver>.yaml` ([ghcup-metadata repo](https://github.com/haskell/ghcup-metadata)), then verify with `ghcup-gen check -f ghcup-<ver>.yaml` and possibly (example only) `ghcup-gen check-tarballs -f ghcup-<ver>.yaml -u 'ghc-8.10.7'`. Generally, new GHC/cabal/stack/hls versions are only added to the latest yaml file. New GHCup versions are added to all (great care must be taken here to not break the parser... e.g. ARM platforms don't parse in all older formats).
4. Commit and git push with tag. Wait for tests to succeed and release artifacts to build.
5. Commit and git push with tag. Wait for tests to succeed and release artifacts to build.
5. Download release artifacts and upload them `downloads.haskell.org/~ghcup` along with checksum files (`sha256sum --tag * > SHA256SUMS && gpg --detach-sign -u <your-email> SHA256SUMS`)
6. Download release artifacts and upload them `downloads.haskell.org/~ghcup` along with checksum files (`sha256sum --tag * > SHA256SUMS && gpg --detach-sign -u <your-email> SHA256SUMS`)
6. Add ghcup release artifacts to ALL yaml files, see [ghcup-metadata repo](https://github.com/haskell/ghcup-metadata)
7. Add ghcup release artifacts to ALL yaml files (see point 4.)
7. Upload the final `ghcup-<ver>.yaml` (and a detached GPG sig of it) to `webhost.haskell.org/ghcup/data/` (for yaml versions <= 0.0.6) as well as [https://github.com/haskell/ghcup-metadata](https://github.com/haskell/ghcup-metadata) (for all versions).
8. Upload the final `ghcup-<ver>.yaml` (and a detached GPG sig of it) to `webhost.haskell.org/ghcup/data/` (for yaml versions <= 0.0.6) as well as [https://github.com/haskell/ghcup-metadata](https://github.com/haskell/ghcup-metadata) (for all versions).
8. Upload `bootstrap-haskell` and `bootstrap-haskell.ps1` to `webhost.haskell.org/ghcup/sh/`
9. Upload `bootstrap-haskell` and `bootstrap-haskell.ps1` to `webhost.haskell.org/ghcup/sh/`
9. Update the top-level ghcup symlinks at `downloads.haskell.org/~ghcup`
10. Update the top-level ghcup symlinks at `downloads.haskell.org/~ghcup`
11. Post on reddit/discourse/etc. and collect rewards
10. Post on reddit/discourse/etc. and collect rewards
# Documentation

View File

@@ -53,6 +53,25 @@ as e.g. `/etc/bash_completion.d/ghcup` (depending on distro)
and make sure your bashrc sources the startup script
(`/usr/share/bash-completion/bash_completion` on some distros).
## Caching
GHCup has a few caching mechanisms to avoid redownloads. All cached files end up in `~/.ghcup/cache` by default.
### Downloads cache
Downloaded tarballs (such as GHC, cabal, etc.) are not cached by default unless you pass `ghcup --cache` or set caching
in your [config](#configuration) via `ghcup config set cache true`.
### Metadata cache
The metadata files (also see [github.com/haskell/ghcup-metadata](https://github.com/haskell/ghcup-metadata))
have a 5 minutes cache per default depending on the last access time of the file. That means if you run
`ghcup list` 10 times in a row, only the first time will trigger a download attempt.
### Clearing the cache
If you experience problems, consider clearing the cache via `ghcup gc --cache`.
## Compiling GHC from source
Compiling from source is supported for both source tarballs and arbitrary git refs. See `ghcup compile ghc --help`

View File

@@ -1,6 +1,6 @@
cabal-version: 3.0
name: ghcup
version: 0.1.17.2
version: 0.1.17.3
license: LGPL-3.0-only
license-file: LICENSE
copyright: Julian Ospald 2020
@@ -18,9 +18,6 @@ build-type: Simple
extra-doc-files:
CHANGELOG.md
data/config.yaml
data/metadata/ghcup-0.0.4.yaml
data/metadata/ghcup-0.0.5.yaml
data/metadata/ghcup-0.0.6.yaml
README.md
extra-source-files:
@@ -46,11 +43,24 @@ flag internal-downloader
default: False
manual: True
flag no-exe
description: Don't build any executables
default: False
manual: True
library
exposed-modules:
GHCup
GHCup.Data.Versions
GHCup.GHC
GHCup.GHC.Rm
GHCup.GHC.Unset
GHCup.GHC.Set
GHCup.GHC.Compile
GHCup.GHC.Common
GHCup.GHC.Install
GHCup.Download
GHCup.Download.Utils
GHCup.Download.Common
GHCup.Errors
GHCup.Platform
GHCup.Requirements
@@ -58,14 +68,16 @@ library
GHCup.Types.JSON
GHCup.Types.Optics
GHCup.Utils
GHCup.Utils.Dirs
GHCup.Utils.File
GHCup.Utils.File.Common
GHCup.Utils.Logger
GHCup.Utils.MegaParsec
GHCup.Utils.Prelude
GHCup.Utils.String.QQ
GHCup.Utils.Version.QQ
GHCup.Directories
GHCup.System.Process
GHCup.System.Directory
GHCup.System.Process.Common
GHCup.System.Console
GHCup.Logger
GHCup.MegaParsec
GHCup.Prelude
GHCup.QQ.String
GHCup.QQ.Version
GHCup.Version
hs-source-dirs: lib
@@ -94,7 +106,7 @@ library
build-depends:
, aeson >=1.4
, async >=0.8 && <2.3
, base >=4.13 && <5
, base >=4.12 && <5
, base16-bytestring >=0.1.1.6 && <1.1
, binary ^>=0.8.6.0
, bytestring ^>=0.10
@@ -150,9 +162,9 @@ library
if os(windows)
cpp-options: -DIS_WINDOWS
other-modules:
GHCup.Utils.File.Windows
GHCup.Utils.Prelude.Windows
GHCup.Utils.Windows
GHCup.System.Process.Windows
GHCup.Prelude.Windows
GHCup.System.Console.Windows
build-depends:
, bzlib
@@ -161,9 +173,9 @@ library
else
other-modules:
GHCup.Utils.File.Posix
GHCup.Utils.Posix
GHCup.Utils.Prelude.Posix
GHCup.System.Process.Posix
GHCup.System.Console.Posix
GHCup.Prelude.Posix
System.Console.Terminal.Common
System.Console.Terminal.Posix
@@ -217,18 +229,19 @@ executable ghcup
, aeson >=1.4
, aeson-pretty ^>=0.8.8
, async ^>=2.2.3
, base >=4.13 && <5
, base >=4.12 && <5
, bytestring ^>=0.10
, cabal-plan ^>=0.7.2
, containers ^>=0.6
, deepseq ^>=1.4
, directory ^>=1.3.6.0
, filepath ^>=1.4.2.1
, ghcup
, haskus-utils-variant >=3.0 && <3.2
, libarchive ^>=3.0.3.0
, megaparsec >=8.0.0 && <9.1
, mtl ^>=2.2
, optparse-applicative >=0.15.1.0 && <0.17
, optparse-applicative-fork >=0.15.1.0 && <0.17
, pretty ^>=1.1.3.1
, pretty-terminal ^>=0.1.0.0
, resourcet ^>=1.2.2
@@ -250,56 +263,15 @@ executable ghcup
build-depends:
, brick ^>=0.64
, transformers ^>=0.5
, unix ^>=2.7
, vector ^>=0.12
, vty >=5.28.2 && <5.34
if os(windows)
cpp-options: -DIS_WINDOWS
executable ghcup-gen
main-is: Main.hs
hs-source-dirs: app/ghcup-gen
other-modules: Validate
default-language: Haskell2010
default-extensions:
DeriveGeneric
LambdaCase
MultiWayIf
NamedFieldPuns
PackageImports
QuasiQuotes
RecordWildCards
ScopedTypeVariables
StrictData
TupleSections
TypeApplications
TypeFamilies
ViewPatterns
ghc-options:
-Wall -fwarn-tabs -fwarn-incomplete-uni-patterns
-fwarn-incomplete-record-updates -threaded
build-depends:
, base >=4.13 && <5
, bytestring ^>=0.10
, containers ^>=0.6
, filepath ^>=1.4.2.1
, ghcup
, haskus-utils-variant >=3.0 && <3.2
, libarchive ^>=3.0.3.0
, mtl ^>=2.2
, optics ^>=0.4
, optparse-applicative >=0.15.1.0 && <0.17
, pretty ^>=1.1.3.1
, pretty-terminal ^>=0.1.0.0
, regex-posix ^>=0.96
, resourcet ^>=1.2.2
, safe-exceptions ^>=0.1
, text ^>=1.2.4.0
, transformers ^>=0.5
, versions >=4.0.1 && <5.1
, yaml-streamly ^>=0.12.0
if flag(no-exe)
buildable: False
test-suite ghcup-test
type: exitcode-stdio-1.0
@@ -325,7 +297,7 @@ test-suite ghcup-test
-fwarn-incomplete-record-updates
build-depends:
, base >=4.13 && <5
, base >=4.12 && <5
, bytestring ^>=0.10
, containers ^>=0.6
, generic-arbitrary ^>=0.1.0

View File

@@ -4,7 +4,5 @@ cradle:
path: ./lib
- component: "ghcup:exe:ghcup"
path: ./app/ghcup
- component: "ghcup:exe:ghcup-gen"
path: "./app/ghcup-gen"
- component: "ghcup:test:ghcup-test"
path: ./test

File diff suppressed because it is too large Load Diff

View File

@@ -5,7 +5,7 @@
{-# LANGUAGE ViewPatterns #-}
{-|
Module : GHCup.Utils.Dirs
Module : GHCup.Directories
Description : Definition of GHCup directories
Copyright : (c) Julian Ospald, 2020
License : LGPL-3.0
@@ -13,7 +13,7 @@ Maintainer : hasufell@hasufell.de
Stability : experimental
Portability : portable
-}
module GHCup.Utils.Dirs
module GHCup.Directories
( getAllDirs
, ghcupBaseDir
, ghcupConfigFile
@@ -35,9 +35,9 @@ import GHCup.Errors
import GHCup.Types
import GHCup.Types.JSON ( )
import GHCup.Types.Optics
import GHCup.Utils.MegaParsec
import GHCup.Utils.Logger
import GHCup.Utils.Prelude
import GHCup.MegaParsec
import GHCup.Logger
import GHCup.Prelude
import Control.Exception.Safe
import Control.Monad

View File

@@ -27,16 +27,16 @@ module GHCup.Download where
#if defined(INTERNAL_DOWNLOADER)
import GHCup.Download.IOStreams
import GHCup.Download.Utils
import GHCup.Download.Common
#endif
import GHCup.Errors
import GHCup.Types
import GHCup.Types.Optics
import GHCup.Types.JSON ( )
import GHCup.Utils.Dirs
import GHCup.Utils.File
import GHCup.Utils.Logger
import GHCup.Utils.Prelude
import GHCup.Directories
import GHCup.System.Process
import GHCup.Logger
import GHCup.Prelude
import GHCup.Version
import Control.Applicative
@@ -242,14 +242,18 @@ getBase uri = do
e <- liftIO $ doesFileExist json_file
currentTime <- liftIO getCurrentTime
Dirs { cacheDir } <- lift getDirs
Settings { metaCache } <- lift getSettings
-- for local files, let's short-circuit and ignore access time
if | scheme == "file" -> liftE $ download uri' Nothing Nothing cacheDir Nothing True
| e -> do
accessTime <- liftIO $ getAccessTime json_file
accessTime <- fmap utcTimeToPOSIXSeconds $ liftIO $ getAccessTime json_file
let sinceLastAccess = utcTimeToPOSIXSeconds currentTime - accessTime
let cacheInterval = fromInteger metaCache
lift $ logDebug $ "last access was " <> T.pack (show sinceLastAccess) <> " ago, cache interval is " <> T.pack (show cacheInterval)
-- access time won't work on most linuxes, but we can try regardless
if | ((utcTimeToPOSIXSeconds currentTime - utcTimeToPOSIXSeconds accessTime) > 300) ->
if | metaCache <= 0 -> dlWithMod currentTime json_file
| (sinceLastAccess > cacheInterval) ->
-- no access in last 5 minutes, re-check upstream mod time
dlWithMod currentTime json_file
| otherwise -> pure json_file

View File

@@ -4,13 +4,13 @@
{-# LANGUAGE TypeFamilies #-}
module GHCup.Download.Utils where
module GHCup.Download.Common where
import GHCup.Errors
import GHCup.Types.Optics
import GHCup.Types.JSON ( )
import GHCup.Utils.Prelude
import GHCup.Prelude
import Control.Applicative
import Control.Monad

View File

@@ -7,10 +7,10 @@
module GHCup.Download.IOStreams where
import GHCup.Download.Utils
import GHCup.Download.Common
import GHCup.Errors
import GHCup.Types.JSON ( )
import GHCup.Utils.Prelude
import GHCup.Prelude
import Control.Applicative
import Control.Exception.Safe

View File

@@ -4,7 +4,7 @@
{-# LANGUAGE OverloadedStrings #-}
{-|
Module : GHCup.Utils.Logger
Module : GHCup.Logger
Description : logger definition
Copyright : (c) Julian Ospald, 2020
License : LGPL-3.0
@@ -14,12 +14,12 @@ Portability : portable
Here we define our main logger.
-}
module GHCup.Utils.Logger where
module GHCup.Logger where
import GHCup.Types
import GHCup.Types.Optics
import {-# SOURCE #-} GHCup.Utils.File.Common
import GHCup.Utils.String.QQ
import {-# SOURCE #-} GHCup.System.Directory
import GHCup.QQ.String
import Control.Exception.Safe
import Control.Monad
@@ -34,7 +34,7 @@ import System.IO.Error
import Text.Regex.Posix
import qualified Data.ByteString as B
import GHCup.Utils.Prelude
import GHCup.Prelude
import qualified Data.Text as T
logInfo :: ( MonadReader env m

View File

@@ -3,7 +3,7 @@
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE OverloadedStrings #-}
module GHCup.Utils.Logger where
module GHCup.Logger where
import GHCup.Types

View File

@@ -2,7 +2,7 @@
{-# LANGUAGE OverloadedStrings #-}
{-|
Module : GHCup.Utils.MegaParsec
Module : GHCup.MegaParsec
Description : MegaParsec utilities
Copyright : (c) Julian Ospald, 2020
License : LGPL-3.0
@@ -10,7 +10,7 @@ Maintainer : hasufell@hasufell.de
Stability : experimental
Portability : portable
-}
module GHCup.Utils.MegaParsec where
module GHCup.MegaParsec where
import GHCup.Types

View File

@@ -1,3 +1,4 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
@@ -22,11 +23,14 @@ import GHCup.Errors
import GHCup.Types
import GHCup.Types.Optics
import GHCup.Types.JSON ( )
import GHCup.Utils.File
import GHCup.Utils.Logger
import GHCup.Utils.Prelude
import GHCup.Utils.String.QQ
import GHCup.System.Process
import GHCup.Logger
import GHCup.Prelude
import GHCup.QQ.String
#if !MIN_VERSION_base(4,13,0)
import Control.Monad.Fail ( MonadFail )
#endif
import Control.Applicative
import Control.Exception.Safe
import Control.Monad

View File

@@ -7,7 +7,7 @@
{-# LANGUAGE TypeOperators #-}
{-|
Module : GHCup.Utils.Prelude
Module : GHCup.Prelude
Description : MegaParsec utilities
Copyright : (c) Julian Ospald, 2020
License : LGPL-3.0
@@ -17,12 +17,12 @@ Portability : portable
GHCup specific prelude. Lots of Excepts functionality.
-}
module GHCup.Utils.Prelude
(module GHCup.Utils.Prelude,
module GHCup.Prelude
(module GHCup.Prelude,
#if defined(IS_WINDOWS)
module GHCup.Utils.Prelude.Windows
module GHCup.Prelude.Windows
#else
module GHCup.Utils.Prelude.Posix
module GHCup.Prelude.Posix
#endif
)
where
@@ -30,11 +30,11 @@ where
import GHCup.Types
import GHCup.Errors
import GHCup.Types.Optics
import {-# SOURCE #-} GHCup.Utils.Logger
import {-# SOURCE #-} GHCup.Logger
#if defined(IS_WINDOWS)
import GHCup.Utils.Prelude.Windows
import GHCup.Prelude.Windows
#else
import GHCup.Utils.Prelude.Posix
import GHCup.Prelude.Posix
#endif
import Control.Applicative
@@ -44,7 +44,7 @@ import Control.Monad.IO.Class
import Control.Monad.Reader
import Data.Bifunctor
import Data.ByteString ( ByteString )
import Data.List ( nub, intercalate, stripPrefix, isPrefixOf, dropWhileEnd )
import Data.List ( nub, intercalate, stripPrefix, isPrefixOf, dropWhileEnd, intersperse )
import Data.Maybe
import Data.Foldable
import Data.List.NonEmpty ( NonEmpty( (:|) ))
@@ -313,18 +313,46 @@ removeLensFieldLabel str' =
maybe str' T.unpack . T.stripPrefix (T.pack "_") . T.pack $ str'
pvpToVersion :: MonadThrow m => PVP -> m Version
pvpToVersion =
either (\_ -> throwM $ ParseError "Couldn't convert PVP to Version") pure . version . prettyPVP
pvpToVersion :: MonadThrow m => PVP -> Text -> m Version
pvpToVersion pvp_ rest =
either (\_ -> throwM $ ParseError "Couldn't convert PVP to Version") pure . version . (<> rest) . prettyPVP $ pvp_
versionToPVP :: MonadThrow m => Version -> m PVP
versionToPVP v = either (\_ -> alternative v) pure . pvp . prettyVer $ v
-- | Convert a version to a PVP and unparsable rest.
--
-- -- prop> \v -> let (Just (pvp', r)) = versionToPVP v in pvpToVersion pvp' r === Just v
versionToPVP :: MonadThrow m => Version -> m (PVP, Text)
versionToPVP (Version (Just _) _ _ _) = throwM $ ParseError "Unexpected epoch"
versionToPVP v = either (\_ -> (, rest v) <$> alternative v) (pure . (, mempty)) . pvp . prettyVer $ v
where
alternative :: MonadThrow m => Version -> m PVP
alternative v' = case NE.takeWhile isDigit (_vChunks v') of
[] -> throwM $ ParseError "Couldn't convert Version to PVP"
xs -> pure $ pvpFromList (unsafeDigit <$> xs)
rest :: Version -> Text
rest (Version _ cs pr me) =
let chunks = NE.dropWhile isDigit cs
ver = intersperse (T.pack ".") . chunksAsT $ chunks
me' = maybe [] (\m -> [T.pack "+",m]) me
pr' = foldable [] (T.pack "-" :) $ intersperse (T.pack ".") (chunksAsT pr)
prefix = case (ver, pr', me') of
(_:_, _, _) -> T.pack "."
_ -> T.pack ""
in prefix <> mconcat (ver <> pr' <> me')
where
chunksAsT :: Functor t => t VChunk -> t Text
chunksAsT = fmap (foldMap f)
where
f :: VUnit -> Text
f (Digits i) = T.pack $ show i
f (Str s) = s
foldable :: Foldable f => f b -> (f a -> f b) -> f a -> f b
foldable d g f | null f = d
| otherwise = g f
isDigit :: VChunk -> Bool
isDigit (Digits _ :| []) = True
isDigit _ = False

View File

@@ -1,4 +1,4 @@
module GHCup.Utils.Prelude.Posix where
module GHCup.Prelude.Posix where
import System.Directory
import System.Posix.Files

View File

@@ -1,4 +1,4 @@
module GHCup.Utils.Prelude.Windows where
module GHCup.Prelude.Windows where
import qualified System.Win32.File as Win32

View File

@@ -1,7 +1,7 @@
{-# LANGUAGE TemplateHaskell #-}
{-|
Module : GHCup.Utils.String.QQ
Module : GHCup.QQ.String
Description : String quasi quoters
Copyright : (c) Audrey Tang <audreyt@audreyt.org> 2019, Julian Ospald <hasufell@posteo.de> 2020
License : LGPL-3.0
@@ -30,7 +30,7 @@ Any instance of the IsString type is permitted.
(For GHC versions 6, write "[$s||]" instead of "[s||]".)
-}
module GHCup.Utils.String.QQ
module GHCup.QQ.String
( s
)
where

View File

@@ -8,7 +8,7 @@
{-|
Module : GHCup.Utils.Version.QQ
Module : GHCup.QQ.Version
Description : Version quasi-quoters
Copyright : (c) Julian Ospald, 2020
License : LGPL-3.0
@@ -16,7 +16,7 @@ Maintainer : hasufell@hasufell.de
Stability : experimental
Portability : portable
-}
module GHCup.Utils.Version.QQ where
module GHCup.QQ.Version where
import Data.Data
import Data.Text ( Text )
@@ -53,6 +53,9 @@ deriving instance Data VUnit
#if !MIN_VERSION_base(4,13,0)
deriving instance Lift (NonEmpty Word)
deriving instance Lift (NonEmpty VChunk)
deriving instance Lift (NonEmpty MChunk)
deriving instance Lift (NonEmpty VUnit)
#endif
qq :: (Text -> Q Exp) -> QuasiQuoter

View File

@@ -0,0 +1,16 @@
{-# LANGUAGE CPP #-}
module GHCup.System.Console (
#if IS_WINDOWS
module GHCup.System.Console.Windows
#else
module GHCup.System.Console.Posix
#endif
) where
#if IS_WINDOWS
import GHCup.System.Console.Windows
#else
import GHCup.System.Console.Posix
#endif

View File

@@ -1,4 +1,4 @@
module GHCup.Utils.Posix where
module GHCup.System.Console.Posix where
-- | Enables ANSI support on windows, does nothing on unix.

View File

@@ -3,7 +3,7 @@
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
module GHCup.Utils.Windows where
module GHCup.System.Console.Windows where
import Control.Exception.Safe

View File

@@ -3,51 +3,24 @@
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE ViewPatterns #-}
module GHCup.Utils.File.Common where
module GHCup.System.Directory where
import GHCup.Utils.Prelude
import GHCup.Prelude
import Control.Monad.Reader
import Data.Maybe
import Data.Text ( Text )
import Data.Void
import GHC.IO.Exception
import Optics hiding ((<|), (|>))
import System.Directory
import System.FilePath
import Text.PrettyPrint.HughesPJClass hiding ( (<>) )
import Text.Regex.Posix
import qualified Data.Text as T
import qualified Data.ByteString.Lazy as BL
import qualified Text.Megaparsec as MP
data ProcessError = NonZeroExit Int FilePath [String]
| PTerminated FilePath [String]
| PStopped FilePath [String]
| NoSuchPid FilePath [String]
deriving Show
instance Pretty ProcessError where
pPrint (NonZeroExit e exe args) =
text "Process" <+> pPrint exe <+> text "with arguments" <+> pPrint args <+> text "failed with exit code" <+> text (show e <> ".")
pPrint (PTerminated exe args) =
text "Process" <+> pPrint exe <+> text "with arguments" <+> pPrint args <+> text "terminated."
pPrint (PStopped exe args) =
text "Process" <+> pPrint exe <+> text "with arguments" <+> pPrint args <+> text "stopped."
pPrint (NoSuchPid exe args) =
text "Could not find PID for process running " <+> pPrint exe <+> text " with arguments " <+> text (show args) <+> text "."
data CapturedProcess = CapturedProcess
{ _exitCode :: ExitCode
, _stdOut :: BL.ByteString
, _stdErr :: BL.ByteString
}
deriving (Eq, Show)
makeLenses ''CapturedProcess

View File

@@ -1,4 +1,4 @@
module GHCup.Utils.File.Common where
module GHCup.System.Directory where
import Text.Regex.Posix

View File

@@ -0,0 +1,19 @@
{-# LANGUAGE CPP #-}
module GHCup.System.Process (
module GHCup.System.Process.Common,
#if IS_WINDOWS
module GHCup.System.Process.Windows
#else
module GHCup.System.Process.Posix
#endif
) where
#if IS_WINDOWS
import GHCup.System.Process.Windows
#else
import GHCup.System.Process.Posix
#endif
import GHCup.System.Process.Common

View File

@@ -0,0 +1,37 @@
{-# LANGUAGE TemplateHaskell #-}
module GHCup.System.Process.Common where
import GHC.IO.Exception
import Optics hiding ((<|), (|>))
import Text.PrettyPrint.HughesPJClass hiding ( (<>) )
import qualified Data.ByteString.Lazy as BL
data ProcessError = NonZeroExit Int FilePath [String]
| PTerminated FilePath [String]
| PStopped FilePath [String]
| NoSuchPid FilePath [String]
deriving Show
instance Pretty ProcessError where
pPrint (NonZeroExit e exe args) =
text "Process" <+> pPrint exe <+> text "with arguments" <+> pPrint args <+> text "failed with exit code" <+> text (show e <> ".")
pPrint (PTerminated exe args) =
text "Process" <+> pPrint exe <+> text "with arguments" <+> pPrint args <+> text "terminated."
pPrint (PStopped exe args) =
text "Process" <+> pPrint exe <+> text "with arguments" <+> pPrint args <+> text "stopped."
pPrint (NoSuchPid exe args) =
text "Could not find PID for process running " <+> pPrint exe <+> text " with arguments " <+> text (show args) <+> text "."
data CapturedProcess = CapturedProcess
{ _exitCode :: ExitCode
, _stdOut :: BL.ByteString
, _stdErr :: BL.ByteString
}
deriving (Eq, Show)
makeLenses ''CapturedProcess

View File

@@ -2,7 +2,7 @@
{-# LANGUAGE FlexibleContexts #-}
{-|
Module : GHCup.Utils.File.Posix
Module : GHCup.System.Process.Posix
Description : File and unix APIs
Copyright : (c) Julian Ospald, 2020
License : LGPL-3.0
@@ -13,13 +13,13 @@ Portability : POSIX
This module handles file and executable handling.
Some of these functions use sophisticated logging.
-}
module GHCup.Utils.File.Posix where
module GHCup.System.Process.Posix where
import GHCup.Utils.File.Common
import GHCup.Utils.Prelude
import GHCup.Utils.Logger
import GHCup.Prelude
import GHCup.Logger
import GHCup.Types
import GHCup.Types.Optics
import GHCup.System.Process.Common
import Control.Concurrent
import Control.Concurrent.Async

View File

@@ -2,7 +2,7 @@
{-# LANGUAGE FlexibleContexts #-}
{-|
Module : GHCup.Utils.File.Windows
Module : GHCup.System.Process.Windows
Description : File and windows APIs
Copyright : (c) Julian Ospald, 2020
License : LGPL-3.0
@@ -13,13 +13,14 @@ Portability : Windows
This module handles file and executable handling.
Some of these functions use sophisticated logging.
-}
module GHCup.Utils.File.Windows where
module GHCup.System.Process.Windows where
import {-# SOURCE #-} GHCup.Utils ( getLinkTarget, pathIsLink )
import GHCup.Utils.Dirs
import GHCup.Utils.File.Common
import GHCup.Directories
import GHCup.Types
import GHCup.Types.Optics
import GHCup.System.Directory
import GHCup.System.Process.Common
import Control.Concurrent
import Control.DeepSeq

View File

@@ -294,6 +294,7 @@ instance NFData (URIRef Absolute) where
data UserSettings = UserSettings
{ uCache :: Maybe Bool
, uMetaCache :: Maybe Integer
, uNoVerify :: Maybe Bool
, uVerbose :: Maybe Bool
, uKeepDirs :: Maybe KeepDirs
@@ -306,12 +307,13 @@ data UserSettings = UserSettings
deriving (Show, GHC.Generic)
defaultUserSettings :: UserSettings
defaultUserSettings = UserSettings Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing
defaultUserSettings = UserSettings Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing
fromSettings :: Settings -> Maybe KeyBindings -> UserSettings
fromSettings Settings{..} Nothing =
UserSettings {
uCache = Just cache
, uMetaCache = Just metaCache
, uNoVerify = Just noVerify
, uVerbose = Just verbose
, uKeepDirs = Just keepDirs
@@ -335,6 +337,7 @@ fromSettings Settings{..} (Just KeyBindings{..}) =
}
in UserSettings {
uCache = Just cache
, uMetaCache = Just metaCache
, uNoVerify = Just noVerify
, uVerbose = Just verbose
, uKeepDirs = Just keepDirs
@@ -410,6 +413,7 @@ instance NFData LeanAppState
data Settings = Settings
{ cache :: Bool
, metaCache :: Integer
, noVerify :: Bool
, keepDirs :: KeepDirs
, downloader :: Downloader
@@ -421,6 +425,12 @@ data Settings = Settings
}
deriving (Show, GHC.Generic)
defaultMetaCache :: Integer
defaultMetaCache = 300 -- 5 minutes
defaultSettings :: Settings
defaultSettings = Settings False defaultMetaCache False Never Curl False GHCupURL False GPGNone False
instance NFData Settings
data Dirs = Dirs

View File

@@ -22,9 +22,9 @@ Portability : portable
module GHCup.Types.JSON where
import GHCup.Types
import GHCup.Utils.MegaParsec
import GHCup.Utils.Prelude
import GHCup.Utils.Logger () -- TH is broken shite and needs GHCup.Utils.Logger for linking, although we don't depend on the file.
import GHCup.MegaParsec
import GHCup.Prelude
import GHCup.Logger () -- TH is broken shite and needs GHCup.Logger for linking, although we don't depend on the file.
-- This is due to the boot file.
import Control.Applicative ( (<|>) )

View File

@@ -20,33 +20,37 @@ This module contains GHCup helpers specific to
installation and introspection of files/versions etc.
-}
module GHCup.Utils
( module GHCup.Utils.Dirs
( module GHCup.Directories
, module GHCup.Utils
#if defined(IS_WINDOWS)
, module GHCup.Utils.Windows
, module GHCup.System.Console.Windows
#else
, module GHCup.Utils.Posix
, module GHCup.System.Console.Posix
#endif
)
where
#if defined(IS_WINDOWS)
import GHCup.Utils.Windows
import GHCup.System.Console.Windows
#else
import GHCup.Utils.Posix
import GHCup.System.Console.Posix
#endif
import {-# SOURCE #-} GHCup.GHC.Common
import {-# SOURCE #-} GHCup.GHC.Set
import GHCup.Data.Versions
import GHCup.Download
import GHCup.Errors
import GHCup.Types
import GHCup.Types.Optics
import GHCup.Types.JSON ( )
import GHCup.Utils.Dirs
import GHCup.Utils.File
import GHCup.Utils.Logger
import GHCup.Utils.MegaParsec
import GHCup.Utils.Prelude
import GHCup.Utils.String.QQ
import GHCup.Directories
import GHCup.Logger
import GHCup.MegaParsec
import GHCup.Prelude
import GHCup.QQ.String
import GHCup.System.Directory
import GHCup.System.Process
import Codec.Archive hiding ( Directory )
import Control.Applicative
@@ -59,6 +63,7 @@ import Control.Monad.Reader
import Control.Monad.Trans.Resource
hiding ( throwM )
import Control.Monad.IO.Unlift ( MonadUnliftIO( withRunInIO ) )
import Data.Bifunctor ( first )
import Data.ByteString ( ByteString )
import Data.Either
import Data.Foldable
@@ -76,6 +81,7 @@ import System.FilePath
import System.IO.Error
import Text.Regex.Posix
import URI.ByteString
import Text.PrettyPrint.HughesPJClass ( prettyShow )
import qualified Codec.Compression.BZip as BZip
import qualified Codec.Compression.GZip as GZip
@@ -96,22 +102,22 @@ import qualified Data.List.NonEmpty as NE
-- >>> import System.Directory
-- >>> import URI.ByteString
-- >>> import qualified Data.Text as T
-- >>> import GHCup.Utils.Prelude
-- >>> import GHCup.Prelude
-- >>> import GHCup.Download
-- >>> import GHCup.Version
-- >>> import GHCup.Errors
-- >>> import GHCup.Types
-- >>> import GHCup.Types.Optics
-- >>> import Optics
-- >>> import GHCup.Utils.Version.QQ
-- >>> import GHCup.QQ.Version
-- >>> import qualified Data.Text.Encoding as E
-- >>> import Control.Monad.Reader
-- >>> import Haskus.Utils.Variant.Excepts
-- >>> import Text.PrettyPrint.HughesPJClass ( prettyShow )
-- >>> let lc = LoggerConfig { lcPrintDebug = False, consoleOutter = mempty, fileOutter = mempty, fancyColors = False }
-- >>> dirs' <- getAllDirs
-- >>> let installedVersions = [ ([pver|8.10.7|], Nothing), ([pver|8.10.4|], Nothing), ([pver|8.8.4|], Nothing), ([pver|8.8.3|], Nothing) ]
-- >>> let settings = Settings True False Never Curl False GHCupURL True GPGNone False
-- >>> let installedVersions = [ ([pver|8.10.7|], "-debug+lol", Nothing), ([pver|8.10.4|], "", Nothing), ([pver|8.8.4|], "", Nothing), ([pver|8.8.3|], "", Nothing) ]
-- >>> let settings = Settings True 0 False Never Curl False GHCupURL True GPGNone False
-- >>> let leanAppState = LeanAppState settings dirs' defaultKeyBindings lc
-- >>> cwd <- getCurrentDirectory
-- >>> (Right ref) <- pure $ parseURI strictURIParserOptions $ "file://" <> E.encodeUtf8 (T.pack cwd) <> "/data/metadata/" <> (urlBaseName . view pathL' $ ghcupURL)
@@ -119,161 +125,6 @@ import qualified Data.List.NonEmpty as NE
------------------------
--[ Symlink handling ]--
------------------------
-- | The symlink destination of a ghc tool.
ghcLinkDestination :: ( MonadReader env m
, HasDirs env
, MonadThrow m, MonadIO m)
=> FilePath -- ^ the tool, such as 'ghc', 'haddock' etc.
-> GHCTargetVersion
-> m FilePath
ghcLinkDestination tool ver = do
Dirs {..} <- getDirs
ghcd <- ghcupGHCDir ver
pure (relativeSymlink binDir (ghcd </> "bin" </> tool))
-- | Removes the minor GHC symlinks, e.g. ghc-8.6.5.
rmMinorSymlinks :: ( MonadReader env m
, HasDirs env
, MonadIO m
, HasLog env
, MonadThrow m
, MonadFail m
, MonadMask m
)
=> GHCTargetVersion
-> Excepts '[NotInstalled] m ()
rmMinorSymlinks tv@GHCTargetVersion{..} = do
Dirs {..} <- lift getDirs
files <- liftE $ ghcToolFiles tv
forM_ files $ \f -> do
let f_xyz = f <> "-" <> T.unpack (prettyVer _tvVersion) <> exeExt
let fullF = binDir </> f_xyz
lift $ logDebug ("rm -f " <> T.pack fullF)
lift $ hideError doesNotExistErrorType $ rmLink fullF
-- | Removes the set ghc version for the given target, if any.
rmPlain :: ( MonadReader env m
, HasDirs env
, HasLog env
, MonadThrow m
, MonadFail m
, MonadIO m
, MonadMask m
)
=> Maybe Text -- ^ target
-> Excepts '[NotInstalled] m ()
rmPlain target = do
Dirs {..} <- lift getDirs
mtv <- lift $ ghcSet target
forM_ mtv $ \tv -> do
files <- liftE $ ghcToolFiles tv
forM_ files $ \f -> do
let fullF = binDir </> f <> exeExt
lift $ logDebug ("rm -f " <> T.pack fullF)
lift $ hideError doesNotExistErrorType $ rmLink fullF
-- old ghcup
let hdc_file = binDir </> "haddock-ghc" <> exeExt
lift $ logDebug ("rm -f " <> T.pack hdc_file)
lift $ hideError doesNotExistErrorType $ rmLink hdc_file
-- | Remove the major GHC symlink, e.g. ghc-8.6.
rmMajorSymlinks :: ( MonadReader env m
, HasDirs env
, MonadIO m
, HasLog env
, MonadThrow m
, MonadFail m
, MonadMask m
)
=> GHCTargetVersion
-> Excepts '[NotInstalled] m ()
rmMajorSymlinks tv@GHCTargetVersion{..} = do
Dirs {..} <- lift getDirs
(mj, mi) <- getMajorMinorV _tvVersion
let v' = intToText mj <> "." <> intToText mi
files <- liftE $ ghcToolFiles tv
forM_ files $ \f -> do
let f_xy = f <> "-" <> T.unpack v' <> exeExt
let fullF = binDir </> f_xy
lift $ logDebug ("rm -f " <> T.pack fullF)
lift $ hideError doesNotExistErrorType $ rmLink fullF
-----------------------------------
--[ Set/Installed introspection ]--
-----------------------------------
-- | Whether the given GHC versin is installed.
ghcInstalled :: (MonadIO m, MonadReader env m, HasDirs env, MonadThrow m) => GHCTargetVersion -> m Bool
ghcInstalled ver = do
ghcdir <- ghcupGHCDir ver
liftIO $ doesDirectoryExist ghcdir
-- | Whether the given GHC version is installed from source.
ghcSrcInstalled :: (MonadIO m, MonadReader env m, HasDirs env, MonadThrow m) => GHCTargetVersion -> m Bool
ghcSrcInstalled ver = do
ghcdir <- ghcupGHCDir ver
liftIO $ doesFileExist (ghcdir </> ghcUpSrcBuiltFile)
-- | Whether the given GHC version is set as the current.
ghcSet :: (MonadReader env m, HasDirs env, MonadThrow m, MonadIO m)
=> Maybe Text -- ^ the target of the GHC version, if any
-- (e.g. armv7-unknown-linux-gnueabihf)
-> m (Maybe GHCTargetVersion)
ghcSet mtarget = do
Dirs {..} <- getDirs
let ghc = maybe "ghc" (\t -> T.unpack t <> "-ghc") mtarget
let ghcBin = binDir </> ghc <> exeExt
-- link destination is of the form ../ghc/<ver>/bin/ghc
-- for old ghcup, it is ../ghc/<ver>/bin/ghc-<ver>
liftIO $ handleIO' NoSuchThing (\_ -> pure Nothing) $ do
link <- liftIO $ getLinkTarget ghcBin
Just <$> ghcLinkVersion link
where
ghcLinkVersion :: MonadThrow m => FilePath -> m GHCTargetVersion
ghcLinkVersion (T.pack . dropSuffix exeExt -> t) = throwEither $ MP.parse parser "ghcLinkVersion" t
where
parser =
(do
_ <- parseUntil1 ghcSubPath
_ <- ghcSubPath
r <- parseUntil1 pathSep
rest <- MP.getInput
MP.setInput r
x <- ghcTargetVerP
MP.setInput rest
pure x
)
<* pathSep
<* MP.takeRest
<* MP.eof
ghcSubPath = pathSep <* MP.chunk "ghc" *> pathSep
-- | Get all installed GHCs by reading ~/.ghcup/ghc/<dir>.
-- If a dir cannot be parsed, returns left.
getInstalledGHCs :: (MonadReader env m, HasDirs env, MonadIO m) => m [Either FilePath GHCTargetVersion]
getInstalledGHCs = do
ghcdir <- ghcupGHCBaseDir
fs <- liftIO $ hideErrorDef [NoSuchThing] [] $ listDirectory ghcdir
forM fs $ \f -> case parseGHCupGHCDir f of
Right r -> pure $ Right r
Left _ -> pure $ Left f
-- | Get all installed cabals, by matching on @~\/.ghcup\/bin/cabal-*@.
@@ -587,79 +438,6 @@ hlsSymlinks = do
-----------------------------------------
--[ Major version introspection (X.Y) ]--
-----------------------------------------
-- | Extract (major, minor) from any version.
getMajorMinorV :: MonadThrow m => Version -> m (Int, Int)
getMajorMinorV Version {..} = case _vChunks of
((Digits x :| []) :| ((Digits y :| []):_)) -> pure (fromIntegral x, fromIntegral y)
_ -> throwM $ ParseError "Could not parse X.Y from version"
matchMajor :: Version -> Int -> Int -> Bool
matchMajor v' major' minor' = case getMajorMinorV v' of
Just (x, y) -> x == major' && y == minor'
Nothing -> False
-- | Match PVP prefix.
--
-- >>> matchPVPrefix [pver|8.8|] [pver|8.8.4|]
-- True
-- >>> matchPVPrefix [pver|8|] [pver|8.8.4|]
-- True
-- >>> matchPVPrefix [pver|8.10|] [pver|8.8.4|]
-- False
-- >>> matchPVPrefix [pver|8.10|] [pver|8.10.7|]
-- True
matchPVPrefix :: PVP -> PVP -> Bool
matchPVPrefix (toL -> prefix) (toL -> full) = and $ zipWith (==) prefix full
toL :: PVP -> [Int]
toL (PVP inner) = fmap fromIntegral $ NE.toList inner
-- | Get the latest installed full GHC version that satisfies the given (possibly partial)
-- PVP version.
getGHCForPVP :: (MonadReader env m, HasDirs env, MonadIO m, MonadThrow m)
=> PVP
-> Maybe Text -- ^ the target triple
-> m (Maybe GHCTargetVersion)
getGHCForPVP pvpIn mt = do
ghcs <- rights <$> getInstalledGHCs
-- we're permissive here... failed parse just means we have no match anyway
let ghcs' = catMaybes $ flip fmap ghcs $ \GHCTargetVersion{..} -> do
pvp_ <- versionToPVP _tvVersion
pure (pvp_, _tvTarget)
getGHCForPVP' pvpIn ghcs' mt
-- | Like 'getGHCForPVP', except with explicit input parameter.
--
-- >>> fmap prettyShow $ getGHCForPVP' [pver|8|] installedVersions Nothing
-- "Just 8.10.7"
-- >>> fmap prettyShow $ getGHCForPVP' [pver|8.8|] installedVersions Nothing
-- "Just 8.8.4"
-- >>> fmap prettyShow $ getGHCForPVP' [pver|8.10.4|] installedVersions Nothing
-- "Just 8.10.4"
getGHCForPVP' :: MonadThrow m
=> PVP
-> [(PVP, Maybe Text)] -- ^ installed GHCs
-> Maybe Text -- ^ the target triple
-> m (Maybe GHCTargetVersion)
getGHCForPVP' pvpIn ghcs' mt = do
let mResult = lastMay
. sortBy (\(x, _) (y, _) -> compare x y)
. filter
(\(pvp_, target) ->
target == mt && matchPVPrefix pvp_ pvpIn
)
$ ghcs'
forM mResult $ \(pvp_, target) -> do
ver' <- pvpToVersion pvp_
pure (GHCTargetVersion target ver')
-- | Get the latest available ghc for the given PVP version, which
@@ -679,7 +457,7 @@ getLatestToolFor :: MonadThrow m
getLatestToolFor tool pvpIn dls = do
let ls = fromMaybe [] $ preview (ix tool % to Map.toDescList) dls
let ps = catMaybes $ fmap (\(v, vi) -> (,vi) <$> versionToPVP v) ls
pure . headMay . filter (\(v, _) -> matchPVPrefix pvpIn v) $ ps
pure . fmap (first fst) . headMay . filter (\((v, _), _) -> matchPVPrefix pvpIn v) $ ps
@@ -809,39 +587,6 @@ getLatestBaseVersion av pvpVer =
-------------
-- | Get tool files from @~\/.ghcup\/bin\/ghc\/\<ver\>\/bin\/\*@
-- while ignoring @*-\<ver\>@ symlinks and accounting for cross triple prefix.
--
-- Returns unversioned relative files without extension, e.g.:
--
-- - @["hsc2hs","haddock","hpc","runhaskell","ghc","ghc-pkg","ghci","runghc","hp2ps"]@
ghcToolFiles :: (MonadReader env m, HasDirs env, MonadThrow m, MonadFail m, MonadIO m)
=> GHCTargetVersion
-> Excepts '[NotInstalled] m [FilePath]
ghcToolFiles ver = do
ghcdir <- lift $ ghcupGHCDir ver
let bindir = ghcdir </> "bin"
-- fail if ghc is not installed
whenM (fmap not $ liftIO $ doesDirectoryExist ghcdir)
(throwE (NotInstalled GHC ver))
files <- liftIO (listDirectory bindir >>= filterM (doesFileExist . (bindir </>)))
pure (getUniqueTools . groupToolFiles . fmap (dropSuffix exeExt) $ files)
where
groupToolFiles :: [FilePath] -> [[(FilePath, String)]]
groupToolFiles = groupBy (\(a, _) (b, _) -> a == b) . fmap (splitOnPVP "-")
getUniqueTools :: [[(FilePath, String)]] -> [String]
getUniqueTools = filter (isNotAnyInfix blackListedTools) . nub . fmap fst . filter ((== "") . snd) . concat
blackListedTools :: [String]
blackListedTools = ["haddock-ghc"]
isNotAnyInfix :: [String] -> String -> Bool
isNotAnyInfix xs t = foldr (\a b -> not (a `isInfixOf` t) && b) True xs
-- | This file, when residing in @~\/.ghcup\/ghc\/\<ver\>\/@ signals that
@@ -1140,3 +885,33 @@ ensureDirectories (Dirs baseDir binDir cacheDir logsDir confDir trashDir) = do
ghcBinaryName :: GHCTargetVersion -> String
ghcBinaryName (GHCTargetVersion (Just t) v') = T.unpack (t <> "-ghc-" <> prettyVer v' <> T.pack exeExt)
ghcBinaryName (GHCTargetVersion Nothing v') = T.unpack ("ghc-" <> prettyVer v' <> T.pack exeExt)
-- | Warn if the installed and set HLS is not compatible with the installed and
-- set GHC version.
warnAboutHlsCompatibility :: ( MonadReader env m
, HasDirs env
, HasLog env
, MonadThrow m
, MonadCatch m
, MonadIO m
)
=> m ()
warnAboutHlsCompatibility = do
supportedGHC <- hlsGHCVersions
currentGHC <- fmap _tvVersion <$> ghcSet Nothing
currentHLS <- hlsSet
case (currentGHC, currentHLS) of
(Just gv, Just hv) | gv `notElem` supportedGHC -> do
logWarn $
"GHC " <> T.pack (prettyShow gv) <> " is not compatible with " <>
"Haskell Language Server " <> T.pack (prettyShow hv) <> "." <> "\n" <>
"Haskell IDE support may not work until this is fixed." <> "\n" <>
"Install a different HLS version, or install and set one of the following GHCs:" <> "\n" <>
T.pack (prettyShow supportedGHC)
_ -> return ()

View File

@@ -1,17 +0,0 @@
{-# LANGUAGE CPP #-}
module GHCup.Utils.File (
module GHCup.Utils.File.Common,
#if IS_WINDOWS
module GHCup.Utils.File.Windows
#else
module GHCup.Utils.File.Posix
#endif
) where
import GHCup.Utils.File.Common
#if IS_WINDOWS
import GHCup.Utils.File.Windows
#else
import GHCup.Utils.File.Posix
#endif

View File

@@ -25,7 +25,7 @@
plat="$(uname -s)"
arch=$(uname -m)
ghver="0.1.17.2"
ghver="0.1.17.3"
base_url="https://downloads.haskell.org/~ghcup"
export GHCUP_SKIP_UPDATE_CHECK=yes

View File

@@ -3,7 +3,7 @@
module GHCup.Types.JSONSpec where
import GHCup.ArbitraryTypes ()
import GHCup.Types
import GHCup.Types hiding ( defaultSettings )
import GHCup.Types.JSON ()
import Test.Aeson.GenericSpecs