Compare commits

...

37 Commits

Author SHA1 Message Date
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
d68ab3b657 Merge branch 'github-metadata' 2021-10-25 22:20:33 +02:00
c10821c332 Use github.com/haskell/ghcup-metadata 2021-10-25 21:47:42 +02:00
219cba5fc7 Fix arm-ness 2021-10-25 21:01:19 +02:00
8e3c74958a Update cabal constraint 2021-10-24 14:22:39 +02:00
ed08e0b166 Use aeson-pretty from hackage 2021-10-24 13:51:23 +02:00
168f2e6d16 Merge branch 'improve-config' 2021-10-22 09:35:46 +02:00
4574f3aa4f Switch to yaml-streamly 2021-10-21 23:39:07 +02:00
2a11e85a95 Allow to specify config value as JSON 2021-10-19 20:46:38 +02:00
69df100b18 Update module graphs 2021-10-17 21:17:14 +02:00
920b027a32 Merge branch 'reduce-win-cpp' 2021-10-17 21:16:59 +02:00
9f8c9c228d Reduce IS_WINDOWS CPP 2021-10-17 20:57:22 +02:00
9d8fdfe090 Merge branch 'refactor-main' 2021-10-17 19:46:20 +02:00
01956d694d Refactor app Main 2021-10-17 19:15:24 +02:00
09d2a1e815 Merge branch 'issue-266' 2021-10-13 22:09:18 +02:00
ccfaedb7ad Migrate to aeson-2.0.1.0 2021-10-13 19:47:14 +02:00
356a69f575 Merge branch 'issue-267' 2021-10-13 19:35:36 +02:00
67 changed files with 6212 additions and 19163 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"

2
.gitignore vendored
View File

@@ -13,3 +13,5 @@ TAGS
/tmp/
.entangled
release/
releases/
site/

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/.brew_cache
- export HOMEBREW_CACHE=$CI_PROJECT_DIR/.brew_cache
- mkdir -p $CI_PROJECT_DIR/.brew_logs
- export HOMEBREW_LOGS=$CI_PROJECT_DIR/.brew_logs
- mkdir -p $CI_PROJECT_DIR/.brew_tmp
- export HOMEBREW_TEMP=$CI_PROJECT_DIR/.brew_tmp
# 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/.brew_cache
- export HOMEBREW_CACHE=$CI_PROJECT_DIR/.brew_cache
- mkdir -p $CI_PROJECT_DIR/.brew_logs
- export HOMEBREW_LOGS=$CI_PROJECT_DIR/.brew_logs
- mkdir -p $CI_PROJECT_DIR/.brew_tmp
- export HOMEBREW_TEMP=$CI_PROJECT_DIR/.brew_tmp
# 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

@@ -5,6 +5,8 @@ set -eux
. "$( cd "$(dirname "$0")" ; pwd -P )/../ghcup_env"
mkdir -p "$CI_PROJECT_DIR"/.local/bin
mkdir -p data/
git clone https://github.com/haskell/ghcup-metadata.git data/metadata
CI_PROJECT_DIR=$(pwd)

View File

@@ -5,6 +5,8 @@ set -eux
. "$( cd "$(dirname "$0")" ; pwd -P )/../ghcup_env"
mkdir -p "$CI_PROJECT_DIR"/.local/bin
mkdir -p data/
git clone https://github.com/haskell/ghcup-metadata.git data/metadata
CI_PROJECT_DIR=$(pwd)

View File

@@ -5,6 +5,8 @@ set -eux
. "$( cd "$(dirname "$0")" ; pwd -P )/../ghcup_env"
mkdir -p "$CI_PROJECT_DIR"/.local/bin
mkdir -p data/
git clone https://github.com/haskell/ghcup-metadata.git data/metadata
CI_PROJECT_DIR=$(pwd)

View File

@@ -5,6 +5,8 @@ set -eux
. "$( cd "$(dirname "$0")" ; pwd -P )/../ghcup_env"
mkdir -p "$CI_PROJECT_DIR"/.local/bin
mkdir -p data/
git clone https://github.com/haskell/ghcup-metadata.git data/metadata
CI_PROJECT_DIR=$(pwd)
@@ -83,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
@@ -92,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

@@ -15,5 +15,5 @@ git describe
ecabal update
ecabal install -w ghc-${GHC_VERSION} --installdir="$CI_PROJECT_DIR"/.local/bin hlint
hlint -r lib/ test/
hlint -r app/ lib/ test/

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,157 +0,0 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TemplateHaskell #-}
{-# 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.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.decode1Strict contents of
Right r -> pure r
Left (_, e) -> die (color Red $ show 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 (notElem (Linux UnknownLinux) pspecs) $ do
lift $ logError $
"Linux UnknownLinux missing for for " <> T.pack (prettyShow t) <> " " <> v' <> " " <> T.pack arch'
addError
when ((notElem Darwin pspecs) && arch == A_64) $ do
lift $ logError $ "Darwin missing for for " <> T.pack (prettyShow t) <> " " <> v' <> " " <> T.pack arch'
addError
when ((notElem FreeBSD pspecs) && arch == A_64) $ lift $ logWarn $
"FreeBSD missing for for " <> T.pack (prettyShow t) <> " " <> v' <> " " <> T.pack arch'
when (notElem Windows 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 (notElem (Linux Alpine) 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 = join $ fmap _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 = join $ fmap _viTags $ M.elems $ availableToolVersions dls tool
forM_ [Latest, Recommended] $ \t -> case elem t 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" *> (flip runReaderT ref addError)
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
(flip runReaderT ref addError)
Just (RegexDir regexString) -> do
logInfo $
"verifying subdir (regex): " <> T.pack regexString
let regex = makeRegexOpts
compIgnoreCase
execBlank
regexString
when (not (match regex basePath)) $ do
logError $
"Subdir doesn't match: expected regex " <> T.pack regexString <> ", got " <> T.pack basePath
(flip runReaderT ref addError)
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)
(flip runReaderT ref addError)

View File

@@ -2,10 +2,7 @@
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE RankNTypes #-}
module BrickMain where
@@ -13,6 +10,7 @@ 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
@@ -43,6 +41,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 )
@@ -51,6 +51,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]
@@ -368,10 +370,7 @@ listSelectedElement' BrickInternalState{..} = fmap (ix, ) $ clr !? ix
selectLatest :: Vector ListResult -> Int
selectLatest v =
case V.findIndex (\ListResult {..} -> lTool == GHC && Latest `elem` lTag) v of
Just ix -> ix
Nothing -> 0
selectLatest = fromMaybe 0 . V.findIndex (\ListResult {..} -> lTool == GHC && Latest `elem` lTag)
-- | Replace the @appState@ or construct it based on a filter function
@@ -398,14 +397,14 @@ filterVisible :: Bool -> Bool -> ListResult -> Bool
filterVisible v t e | lInstalled e = True
| v
, not t
, not (elem (lTool e) hiddenTools) = True
, lTool e `notElem` hiddenTools = True
| not v
, t
, not (elem Old (lTag e)) = True
, Old `notElem` lTag e = True
| v
, t = True
| otherwise = not (elem Old (lTag e)) &&
not (elem (lTool e) hiddenTools)
| otherwise = (Old `notElem` lTag e) &&
(lTool e `notElem` hiddenTools)
install' :: (MonadReader AppState m, MonadIO m, MonadThrow m, MonadFail m, MonadMask m, MonadUnliftIO m)
@@ -438,27 +437,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 ()
@@ -507,7 +521,7 @@ del' _ (_, ListResult {..}) = do
)
>>= \case
VRight vi -> do
forM_ (join $ fmap _viPostRemove vi) $ \msg ->
forM_ (_viPostRemove =<< vi) $ \msg ->
logInfo msg
pure $ Right ()
VLeft e -> pure $ Left (prettyShow e)
@@ -542,17 +556,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)
@@ -594,8 +598,7 @@ getGHCupInfo = do
r <-
flip runReaderT settings
. runE @'[DigestError, GPGError, JSONError , DownloadFailed , FileDoesNotExistError]
$ liftE
$ getDownloadsF
$ liftE getDownloadsF
case r of
VRight a -> pure $ Right a
@@ -612,4 +615,3 @@ getAppData mgi = runExceptT $ do
flip runReaderT settings $ do
lV <- listVersions Nothing Nothing
pure $ BrickData (reverse lV)

305
app/ghcup/GHCup/OptParse.hs Normal file
View File

@@ -0,0 +1,305 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE DuplicateRecordFields #-}
module GHCup.OptParse (
module GHCup.OptParse.Common
, module GHCup.OptParse.Install
, module GHCup.OptParse.Set
, module GHCup.OptParse.UnSet
, module GHCup.OptParse.Rm
, module GHCup.OptParse.Compile
, module GHCup.OptParse.Config
, module GHCup.OptParse.Whereis
, module GHCup.OptParse.List
, module GHCup.OptParse.Upgrade
, module GHCup.OptParse.ChangeLog
, module GHCup.OptParse.Prefetch
, module GHCup.OptParse.GC
, module GHCup.OptParse.DInfo
, module GHCup.OptParse.Nuke
, module GHCup.OptParse.ToolRequirements
, module GHCup.OptParse
) where
import GHCup.OptParse.Common
import GHCup.OptParse.Install
import GHCup.OptParse.Set
import GHCup.OptParse.UnSet
import GHCup.OptParse.Rm
import GHCup.OptParse.Compile
import GHCup.OptParse.Config
import GHCup.OptParse.Whereis
import GHCup.OptParse.List
import GHCup.OptParse.Upgrade
import GHCup.OptParse.ChangeLog
import GHCup.OptParse.Prefetch
import GHCup.OptParse.GC
import GHCup.OptParse.DInfo
import GHCup.OptParse.ToolRequirements
import GHCup.OptParse.Nuke
import GHCup.Types
#if !MIN_VERSION_base(4,13,0)
import Control.Monad.Fail ( MonadFail )
#endif
import Control.Monad.Reader
import Data.Bifunctor
import Data.Either
import Data.Functor
import Data.Maybe
import Options.Applicative hiding ( style )
import Options.Applicative.Help.Pretty ( text )
import Prelude hiding ( appendFile )
import URI.ByteString
import qualified Data.ByteString.UTF8 as UTF8
data Options = Options
{
-- global options
optVerbose :: Maybe Bool
, optCache :: Maybe Bool
, optMetaCache :: Maybe Integer
, optUrlSource :: Maybe URI
, optNoVerify :: Maybe Bool
, optKeepDirs :: Maybe KeepDirs
, optsDownloader :: Maybe Downloader
, optNoNetwork :: Maybe Bool
, optGpg :: Maybe GPGSetting
-- commands
, optCommand :: Command
}
data Command
= Install (Either InstallCommand InstallOptions)
| InstallCabalLegacy InstallOptions
| Set (Either SetCommand SetOptions)
| UnSet UnsetCommand
| List ListOptions
| Rm (Either RmCommand RmOptions)
| DInfo
| Compile CompileCommand
| Config ConfigCommand
| Whereis WhereisOptions WhereisCommand
| Upgrade UpgradeOpts Bool
| ToolRequirements
| ChangeLog ChangeLogOptions
| Nuke
#if defined(BRICK)
| Interactive
#endif
| Prefetch PrefetchCommand
| GC GCOptions
opts :: Parser Options
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)
( short 's'
<> long "url-source"
<> metavar "URL"
<> help "Alternative ghcup download info url"
<> internal
)
)
<*> (fmap . fmap) not (invertableSwitch "verify" 'n' True (help "Disable tarball checksum verification (default: enabled)"))
<*> optional (option
(eitherReader keepOnParser)
( long "keep"
<> metavar "<always|errors|never>"
<> help
"Keep build directories? (default: errors)"
<> hidden
))
<*> optional (option
(eitherReader downloaderParser)
( long "downloader"
#if defined(INTERNAL_DOWNLOADER)
<> metavar "<internal|curl|wget>"
<> help
"Downloader to use (default: internal)"
#else
<> metavar "<curl|wget>"
<> help
"Downloader to use (default: curl)"
#endif
<> hidden
))
<*> invertableSwitch "offline" 'o' False (help "Don't do any network calls, trying cached assets and failing if missing.")
<*> optional (option
(eitherReader gpgParser)
( long "gpg"
<> metavar "<strict|lax|none>"
<> help
"GPG verification (default: none)"
))
<*> com
where
parseUri s' =
first show $ parseURI strictURIParserOptions (UTF8.fromString s')
com :: Parser Command
com =
subparser
#if defined(BRICK)
( command
"tui"
( (\_ -> Interactive)
<$> info
helper
( progDesc "Start the interactive GHCup UI"
)
)
<> command
#else
( command
#endif
"install"
( Install
<$> info
(installParser <**> helper)
( progDesc "Install or update GHC/cabal/HLS/stack"
<> footerDoc (Just $ text installToolFooter)
)
)
<> command
"set"
(info
(Set <$> setParser <**> helper)
( progDesc "Set currently active GHC/cabal version"
<> footerDoc (Just $ text setFooter)
)
)
<> command
"unset"
(info
(UnSet <$> unsetParser <**> helper)
( progDesc "Unset currently active GHC/cabal version"
<> footerDoc (Just $ text unsetFooter)
)
)
<> command
"rm"
(info
(Rm <$> rmParser <**> helper)
( progDesc "Remove a GHC/cabal/HLS/stack version"
<> footerDoc (Just $ text rmFooter)
)
)
<> command
"list"
(info (List <$> listOpts <**> helper)
(progDesc "Show available GHCs and other tools")
)
<> command
"upgrade"
(info
( (Upgrade <$> upgradeOptsP <*> switch
(short 'f' <> long "force" <> help "Force update")
)
<**> helper
)
(progDesc "Upgrade ghcup")
)
<> command
"compile"
( Compile
<$> info (compileP <**> helper)
(progDesc "Compile a tool from source")
)
<> command
"whereis"
(info
( (Whereis
<$> (WhereisOptions <$> switch (short 'd' <> long "directory" <> help "return directory of the binary instead of the binary location"))
<*> whereisP
) <**> helper
)
(progDesc "Find a tools location"
<> footerDoc ( Just $ text whereisFooter ))
)
<> command
"prefetch"
(info
( (Prefetch
<$> prefetchP
) <**> helper
)
(progDesc "Prefetch assets"
<> footerDoc ( Just $ text prefetchFooter ))
)
<> command
"gc"
(info
( (GC
<$> gcP
) <**> helper
)
(progDesc "Garbage collection"
<> footerDoc ( Just $ text gcFooter ))
)
<> commandGroup "Main commands:"
)
<|> subparser
( command
"debug-info"
((\_ -> DInfo) <$> info helper (progDesc "Show debug info"))
<> command
"tool-requirements"
( (\_ -> ToolRequirements)
<$> info helper
(progDesc "Show the requirements for ghc/cabal")
)
<> command
"changelog"
(info
(fmap ChangeLog changelogP <**> helper)
( progDesc "Find/show changelog"
<> footerDoc (Just $ text changeLogFooter)
)
)
<> command
"config"
( Config
<$> info (configP <**> helper)
(progDesc "Show or set config" <> footerDoc (Just $ text configFooter))
)
<> commandGroup "Other commands:"
<> hidden
)
<|> subparser
( command
"install-cabal"
(info
((InstallCabalLegacy <$> installOpts (Just Cabal)) <**> helper)
( progDesc "Install or update cabal"
<> footerDoc (Just $ text installCabalFooter)
)
)
<> internal
)
<|> subparser
(command
"nuke"
(info (pure Nuke <**> helper)
(progDesc "Completely remove ghcup from your system"))
<> commandGroup "Nuclear Commands:"
<> hidden
)

View File

@@ -0,0 +1,150 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE RankNTypes #-}
module GHCup.OptParse.ChangeLog where
import GHCup.Types
import GHCup.Utils.Logger
import GHCup.OptParse.Common
import GHCup.Utils.String.QQ
#if !MIN_VERSION_base(4,13,0)
import Control.Monad.Fail ( MonadFail )
#endif
import Control.Monad.Reader
import Control.Monad.Trans.Resource
import Data.Functor
import Data.Maybe
import Options.Applicative hiding ( style )
import Prelude hiding ( appendFile )
import System.Exit
import Text.PrettyPrint.HughesPJClass ( prettyShow )
import qualified Data.Text as T
import Control.Exception.Safe (MonadMask)
import GHCup.Types.Optics
import GHCup.Utils
import Data.Versions
import URI.ByteString (serializeURIRef')
import GHCup.Utils.Prelude
import GHCup.Utils.File (exec)
import Data.Char (toLower)
---------------
--[ Options ]--
---------------
data ChangeLogOptions = ChangeLogOptions
{ clOpen :: Bool
, clTool :: Maybe Tool
, clToolVer :: Maybe ToolVersion
}
---------------
--[ Parsers ]--
---------------
changelogP :: Parser ChangeLogOptions
changelogP =
(\x y -> ChangeLogOptions x y)
<$> switch (short 'o' <> long "open" <> help "xdg-open the changelog url")
<*> optional
(option
(eitherReader
(\s' -> case fmap toLower s' of
"ghc" -> Right GHC
"cabal" -> Right Cabal
"ghcup" -> Right GHCup
"stack" -> Right Stack
e -> Left e
)
)
(short 't' <> long "tool" <> metavar "<ghc|cabal|ghcup>" <> help
"Open changelog for given tool (default: ghc)"
)
)
<*> optional (toolVersionArgument Nothing Nothing)
--------------
--[ Footer ]--
--------------
changeLogFooter :: String
changeLogFooter = [s|Discussion:
By default returns the URI of the ChangeLog of the latest GHC release.
Pass '-o' to automatically open via xdg-open.|]
------------------
--[ Entrypoint ]--
------------------
changelog :: ( Monad m
, MonadMask m
, MonadUnliftIO m
, MonadFail m
)
=> ChangeLogOptions
-> (forall a . ReaderT AppState m a -> m a)
-> (ReaderT LeanAppState m () -> m ())
-> m ExitCode
changelog ChangeLogOptions{..} runAppState runLogger = do
GHCupInfo { _ghcupDownloads = dls } <- runAppState getGHCupInfo
let tool = fromMaybe GHC clTool
ver' = maybe
(Right Latest)
(\case
ToolVersion tv -> Left (_tvVersion tv) -- FIXME: ugly sharing of ToolVersion
ToolTag t -> Right t
)
clToolVer
muri = getChangeLog dls tool ver'
case muri of
Nothing -> do
runLogger
(logWarn $
"Could not find ChangeLog for " <> T.pack (prettyShow tool) <> ", version " <> either prettyVer (T.pack . show) ver'
)
pure ExitSuccess
Just uri -> do
pfreq <- runAppState getPlatformReq
let uri' = T.unpack . decUTF8Safe . serializeURIRef' $ uri
cmd = case _rPlatform pfreq of
Darwin -> "open"
Linux _ -> "xdg-open"
FreeBSD -> "xdg-open"
Windows -> "start"
if clOpen
then do
runAppState $
exec cmd
[T.unpack $ decUTF8Safe $ serializeURIRef' uri]
Nothing
Nothing
>>= \case
Right _ -> pure ExitSuccess
Left e -> logError (T.pack $ prettyShow e)
>> pure (ExitFailure 13)
else liftIO $ putStrLn uri' >> pure ExitSuccess

View File

@@ -0,0 +1,513 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE DuplicateRecordFields #-}
module GHCup.OptParse.Common where
import GHCup
import GHCup.Download
import GHCup.Errors
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 Control.Exception.Safe
#if !MIN_VERSION_base(4,13,0)
import Control.Monad.Fail ( MonadFail )
#endif
import Control.Monad.Reader
import Data.Bifunctor
import Data.Char
import Data.Either
import Data.Functor
import Data.List ( nub, sort, sortBy )
import Data.Maybe
import Data.Text ( Text )
import Data.Versions hiding ( str )
import Data.Void
import Haskus.Utils.Variant.Excepts
import Options.Applicative hiding ( style )
import Prelude hiding ( appendFile )
import Safe
import System.FilePath
import URI.ByteString
import qualified Data.ByteString.UTF8 as UTF8
import qualified Data.Map.Strict as M
import qualified Data.Text as T
import qualified Text.Megaparsec as MP
import GHCup.Version
-------------
--[ Types ]--
-------------
data ToolVersion = ToolVersion GHCTargetVersion -- target is ignored for cabal
| ToolTag Tag
-- a superset of ToolVersion
data SetToolVersion = SetToolVersion GHCTargetVersion
| SetToolTag Tag
| SetRecommended
| SetNext
prettyToolVer :: ToolVersion -> String
prettyToolVer (ToolVersion v') = T.unpack $ tVerToText v'
prettyToolVer (ToolTag t) = show t
toSetToolVer :: Maybe ToolVersion -> SetToolVersion
toSetToolVer (Just (ToolVersion v')) = SetToolVersion v'
toSetToolVer (Just (ToolTag t')) = SetToolTag t'
toSetToolVer Nothing = SetRecommended
--------------
--[ Parser ]--
--------------
-- | same as toolVersionParser, except as an argument.
toolVersionArgument :: Maybe ListCriteria -> Maybe Tool -> Parser ToolVersion
toolVersionArgument criteria tool =
argument (eitherReader toolVersionEither)
(metavar (mv tool)
<> completer (tagCompleter (fromMaybe GHC tool) [])
<> foldMap (completer . versionCompleter criteria) tool)
where
mv (Just GHC) = "GHC_VERSION|TAG"
mv (Just HLS) = "HLS_VERSION|TAG"
mv _ = "VERSION|TAG"
versionParser :: Parser GHCTargetVersion
versionParser = option
(eitherReader tVersionEither)
(short 'v' <> long "version" <> metavar "VERSION" <> help "The target version"
)
versionParser' :: Maybe ListCriteria -> Maybe Tool -> Parser Version
versionParser' criteria tool = argument
(eitherReader (first show . version . T.pack))
(metavar "VERSION" <> foldMap (completer . versionCompleter criteria) tool)
versionArgument :: Maybe ListCriteria -> Maybe Tool -> Parser GHCTargetVersion
versionArgument criteria tool = argument (eitherReader tVersionEither) (metavar "VERSION" <> foldMap (completer . versionCompleter criteria) tool)
-- https://github.com/pcapriotti/optparse-applicative/issues/148
-- | A switch that can be enabled using --foo and disabled using --no-foo.
--
-- The option modifier is applied to only the option that is *not* enabled
-- by default. For example:
--
-- > invertableSwitch "recursive" True (help "do not recurse into directories")
--
-- This example makes --recursive enabled by default, so
-- the help is shown only for --no-recursive.
invertableSwitch
:: String -- ^ long option
-> Char -- ^ short option for the non-default option
-> Bool -- ^ is switch enabled by default?
-> Mod FlagFields Bool -- ^ option modifier
-> Parser (Maybe Bool)
invertableSwitch longopt shortopt defv optmod = invertableSwitch' longopt shortopt defv
(if defv then mempty else optmod)
(if defv then optmod else mempty)
-- | Allows providing option modifiers for both --foo and --no-foo.
invertableSwitch'
:: String -- ^ long option (eg "foo")
-> Char -- ^ short option for the non-default option
-> Bool -- ^ is switch enabled by default?
-> Mod FlagFields Bool -- ^ option modifier for --foo
-> Mod FlagFields Bool -- ^ option modifier for --no-foo
-> Parser (Maybe Bool)
invertableSwitch' longopt shortopt defv enmod dismod = optional
( flag' True ( enmod <> long longopt <> if defv then mempty else short shortopt)
<|> flag' False (dismod <> long nolongopt <> if defv then short shortopt else mempty)
)
where
nolongopt = "no-" ++ longopt
---------------------
--[ Either Parser ]--
---------------------
platformParser :: String -> Either String PlatformRequest
platformParser s' = case MP.parse (platformP <* MP.eof) "" (T.pack s') of
Right r -> pure r
Left e -> Left $ errorBundlePretty e
where
archP :: MP.Parsec Void Text Architecture
archP = MP.try (MP.chunk "x86_64" $> A_64) <|> (MP.chunk "i386" $> A_32)
platformP :: MP.Parsec Void Text PlatformRequest
platformP = choice'
[ (`PlatformRequest` FreeBSD)
<$> (archP <* MP.chunk "-")
<*> ( MP.chunk "portbld"
*> ( MP.try (Just <$> verP (MP.chunk "-freebsd" <* MP.eof))
<|> pure Nothing
)
<* MP.chunk "-freebsd"
)
, (`PlatformRequest` Darwin)
<$> (archP <* MP.chunk "-")
<*> ( MP.chunk "apple"
*> ( MP.try (Just <$> verP (MP.chunk "-darwin" <* MP.eof))
<|> pure Nothing
)
<* MP.chunk "-darwin"
)
, (\a d mv -> PlatformRequest a (Linux d) mv)
<$> (archP <* MP.chunk "-")
<*> distroP
<*> ((MP.try (Just <$> verP (MP.chunk "-linux" <* MP.eof)) <|> pure Nothing
)
<* MP.chunk "-linux"
)
]
distroP :: MP.Parsec Void Text LinuxDistro
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
]
bindistParser :: String -> Either String URI
bindistParser = first show . parseURI strictURIParserOptions . UTF8.fromString
absolutePathParser :: FilePath -> Either String FilePath
absolutePathParser f = case isValid f && isAbsolute f of
True -> Right $ normalise f
False -> Left "Please enter a valid absolute filepath."
isolateParser :: FilePath -> Either String FilePath
isolateParser f = case isValid f of
True -> Right $ normalise f
False -> Left "Please enter a valid filepath for isolate dir."
toolVersionEither :: String -> Either String ToolVersion
toolVersionEither s' =
second ToolTag (tagEither s') <|> second ToolVersion (tVersionEither s')
tagEither :: String -> Either String Tag
tagEither s' = case fmap toLower s' of
"recommended" -> Right Recommended
"latest" -> Right Latest
('b':'a':'s':'e':'-':ver') -> case pvp (T.pack ver') of
Right x -> Right (Base x)
Left _ -> Left $ "Invalid PVP version for base " <> ver'
other -> Left $ "Unknown tag " <> other
tVersionEither :: String -> Either String GHCTargetVersion
tVersionEither =
first (const "Not a valid version") . MP.parse ghcTargetVerP "" . T.pack
toolParser :: String -> Either String Tool
toolParser s' | t == T.pack "ghc" = Right GHC
| t == T.pack "cabal" = Right Cabal
| t == T.pack "hls" = Right HLS
| t == T.pack "stack" = Right Stack
| otherwise = Left ("Unknown tool: " <> s')
where t = T.toLower (T.pack s')
criteriaParser :: String -> Either String ListCriteria
criteriaParser s' | t == T.pack "installed" = Right ListInstalled
| t == T.pack "set" = Right ListSet
| t == T.pack "available" = Right ListAvailable
| otherwise = Left ("Unknown criteria: " <> s')
where t = T.toLower (T.pack s')
toolVersionParser :: Parser ToolVersion
toolVersionParser = verP' <|> toolP
where
verP' = ToolVersion <$> versionParser
toolP =
ToolTag
<$> option
(eitherReader tagEither)
(short 't' <> long "tag" <> metavar "TAG" <> help "The target tag")
keepOnParser :: String -> Either String KeepDirs
keepOnParser s' | t == T.pack "always" = Right Always
| t == T.pack "errors" = Right Errors
| t == T.pack "never" = Right Never
| otherwise = Left ("Unknown keep value: " <> s')
where t = T.toLower (T.pack s')
downloaderParser :: String -> Either String Downloader
downloaderParser s' | t == T.pack "curl" = Right Curl
| t == T.pack "wget" = Right Wget
#if defined(INTERNAL_DOWNLOADER)
| t == T.pack "internal" = Right Internal
#endif
| otherwise = Left ("Unknown downloader value: " <> s')
where t = T.toLower (T.pack s')
gpgParser :: String -> Either String GPGSetting
gpgParser s' | t == T.pack "strict" = Right GPGStrict
| t == T.pack "lax" = Right GPGLax
| t == T.pack "none" = Right GPGNone
| otherwise = Left ("Unknown gpg setting value: " <> s')
where t = T.toLower (T.pack s')
------------------
--[ Completers ]--
------------------
tagCompleter :: Tool -> [String] -> Completer
tagCompleter tool add = listIOCompleter $ do
dirs' <- liftIO getAllDirs
let loggerConfig = LoggerConfig
{ lcPrintDebug = False
, consoleOutter = mempty
, fileOutter = mempty
, fancyColors = False
}
let appState = LeanAppState
(defaultSettings { noNetwork = True })
dirs'
defaultKeyBindings
loggerConfig
mGhcUpInfo <- flip runReaderT appState . runE $ getDownloadsF
case mGhcUpInfo of
VRight ghcupInfo -> do
let allTags = filter (/= Old)
$ _viTags =<< M.elems (availableToolVersions (_ghcupDownloads ghcupInfo) tool)
pure $ nub $ (add ++) $ fmap tagToString allTags
VLeft _ -> pure (nub $ ["recommended", "latest"] ++ add)
versionCompleter :: Maybe ListCriteria -> Tool -> Completer
versionCompleter criteria tool = listIOCompleter $ do
dirs' <- liftIO getAllDirs
let loggerConfig = LoggerConfig
{ lcPrintDebug = False
, consoleOutter = mempty
, fileOutter = mempty
, fancyColors = False
}
let settings = defaultSettings { noNetwork = True }
let leanAppState = LeanAppState
settings
dirs'
defaultKeyBindings
loggerConfig
mpFreq <- flip runReaderT leanAppState . runE $ platformRequest
mGhcUpInfo <- flip runReaderT leanAppState . runE $ getDownloadsF
forFold mpFreq $ \pfreq -> do
forFold mGhcUpInfo $ \ghcupInfo -> do
let appState = AppState
settings
dirs'
defaultKeyBindings
ghcupInfo
pfreq
loggerConfig
runEnv = flip runReaderT appState
installedVersions <- runEnv $ listVersions (Just tool) criteria
return $ T.unpack . prettyVer . lVer <$> installedVersions
-----------------
--[ Utilities ]--
-----------------
fromVersion :: ( HasLog env
, MonadFail m
, MonadReader env m
, HasGHCupInfo env
, HasDirs env
, MonadThrow m
, MonadIO m
, MonadCatch m
)
=> Maybe ToolVersion
-> Tool
-> Excepts
'[ TagNotFound
, NextVerNotFound
, NoToolVersionSet
] m (GHCTargetVersion, Maybe VersionInfo)
fromVersion tv = fromVersion' (toSetToolVer tv)
fromVersion' :: ( HasLog env
, MonadFail m
, MonadReader env m
, HasGHCupInfo env
, HasDirs env
, MonadThrow m
, MonadIO m
, MonadCatch m
)
=> SetToolVersion
-> Tool
-> Excepts
'[ TagNotFound
, NextVerNotFound
, NoToolVersionSet
] m (GHCTargetVersion, Maybe VersionInfo)
fromVersion' SetRecommended tool = do
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
bimap mkTVer Just <$> getRecommended dls tool
?? TagNotFound Recommended tool
fromVersion' (SetToolVersion v) tool = do
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
let vi = getVersionInfo (_tvVersion v) tool dls
case pvp $ prettyVer (_tvVersion v) of -- need to be strict here
Left _ -> pure (v, vi)
Right pvpIn ->
lift (getLatestToolFor tool pvpIn dls) >>= \case
Just (pvp_, vi') -> do
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)
fromVersion' (SetToolTag Latest) tool = do
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
bimap mkTVer Just <$> getLatest dls tool ?? TagNotFound Latest tool
fromVersion' (SetToolTag Recommended) tool = do
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
bimap mkTVer Just <$> getRecommended dls tool ?? TagNotFound Recommended tool
fromVersion' (SetToolTag (Base pvp'')) GHC = do
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
bimap mkTVer Just <$> getLatestBaseVersion dls pvp'' ?? TagNotFound (Base pvp'') GHC
fromVersion' SetNext tool = do
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
next <- case tool of
GHC -> do
set <- fmap _tvVersion $ ghcSet Nothing !? NoToolVersionSet tool
ghcs <- rights <$> lift getInstalledGHCs
(headMay
. tail
. dropWhile (\GHCTargetVersion {..} -> _tvVersion /= set)
. cycle
. sortBy (\x y -> compare (_tvVersion x) (_tvVersion y))
. filter (\GHCTargetVersion {..} -> isNothing _tvTarget)
$ ghcs) ?? NoToolVersionSet tool
Cabal -> do
set <- cabalSet !? NoToolVersionSet tool
cabals <- rights <$> lift getInstalledCabals
(fmap (GHCTargetVersion Nothing)
. headMay
. tail
. dropWhile (/= set)
. cycle
. sort
$ cabals) ?? NoToolVersionSet tool
HLS -> do
set <- hlsSet !? NoToolVersionSet tool
hlses <- rights <$> lift getInstalledHLSs
(fmap (GHCTargetVersion Nothing)
. headMay
. tail
. dropWhile (/= set)
. cycle
. sort
$ hlses) ?? NoToolVersionSet tool
Stack -> do
set <- stackSet !? NoToolVersionSet tool
stacks <- rights <$> lift getInstalledStacks
(fmap (GHCTargetVersion Nothing)
. headMay
. tail
. dropWhile (/= set)
. cycle
. sort
$ stacks) ?? NoToolVersionSet tool
GHCup -> fail "GHCup cannot be set"
let vi = getVersionInfo (_tvVersion next) tool dls
pure (next, vi)
fromVersion' (SetToolTag t') tool =
throwE $ TagNotFound t' tool
checkForUpdates :: ( MonadReader env m
, HasGHCupInfo env
, HasDirs env
, HasPlatformReq env
, MonadCatch m
, HasLog env
, MonadThrow m
, MonadIO m
, MonadFail m
)
=> m ()
checkForUpdates = do
GHCupInfo { _ghcupDownloads = dls } <- getGHCupInfo
lInstalled <- listVersions Nothing (Just ListInstalled)
let latestInstalled tool = (fmap lVer . lastMay . filter (\lr -> lTool lr == tool)) lInstalled
forM_ (getLatest dls GHCup) $ \(l, _) -> do
(Right ghc_ver) <- pure $ version $ prettyPVP ghcUpVer
when (l > ghc_ver)
$ logWarn $
"New GHCup version available: " <> prettyVer l <> ". To upgrade, run 'ghcup upgrade'"
forM_ (getLatest dls GHC) $ \(l, _) -> do
let mghc_ver = latestInstalled GHC
forM mghc_ver $ \ghc_ver ->
when (l > ghc_ver)
$ logWarn $
"New GHC version available: " <> prettyVer l <> ". To upgrade, run 'ghcup install ghc " <> prettyVer l <> "'"
forM_ (getLatest dls Cabal) $ \(l, _) -> do
let mcabal_ver = latestInstalled Cabal
forM mcabal_ver $ \cabal_ver ->
when (l > cabal_ver)
$ logWarn $
"New Cabal version available: " <> prettyVer l <> ". To upgrade, run 'ghcup install cabal " <> prettyVer l <> "'"
forM_ (getLatest dls HLS) $ \(l, _) -> do
let mhls_ver = latestInstalled HLS
forM mhls_ver $ \hls_ver ->
when (l > hls_ver)
$ logWarn $
"New HLS version available: " <> prettyVer l <> ". To upgrade, run 'ghcup install hls " <> prettyVer l <> "'"
forM_ (getLatest dls Stack) $ \(l, _) -> do
let mstack_ver = latestInstalled Stack
forM mstack_ver $ \stack_ver ->
when (l > stack_ver)
$ logWarn $
"New Stack version available: " <> prettyVer l <> ". To upgrade, run 'ghcup install stack " <> prettyVer l <> "'"

View File

@@ -0,0 +1,517 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE RankNTypes #-}
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.OptParse.Common
import GHCup.Utils.String.QQ
#if !MIN_VERSION_base(4,13,0)
import Control.Monad.Fail ( MonadFail )
#endif
import Codec.Archive ( ArchiveResult )
import Control.Concurrent (threadDelay)
import Control.Monad.Reader
import Control.Monad.Trans.Resource
import Data.Bifunctor
import Data.Functor
import Data.Maybe
import Data.Versions ( Version, prettyVer, version )
import Data.Text ( Text )
import Haskus.Utils.Variant.Excepts
import Options.Applicative hiding ( style )
import Options.Applicative.Help.Pretty ( text )
import Prelude hiding ( appendFile )
import System.Exit
import Text.PrettyPrint.HughesPJClass ( prettyShow )
import qualified Data.Text as T
import Control.Exception.Safe (MonadMask)
import System.FilePath (isPathSeparator)
import Text.Read (readEither)
----------------
--[ Commands ]--
----------------
data CompileCommand = CompileGHC GHCCompileOptions
| CompileHLS HLSCompileOptions
---------------
--[ Options ]--
---------------
data GHCCompileOptions = GHCCompileOptions
{ targetGhc :: Either Version GitBranch
, bootstrapGhc :: Either Version FilePath
, jobs :: Maybe Int
, buildConfig :: Maybe FilePath
, patchDir :: Maybe FilePath
, crossTarget :: Maybe Text
, addConfArgs :: [Text]
, setCompile :: Bool
, ovewrwiteVer :: Maybe Version
, buildFlavour :: Maybe String
, hadrian :: Bool
, isolateDir :: Maybe FilePath
}
data HLSCompileOptions = HLSCompileOptions
{ targetHLS :: Either Version GitBranch
, jobs :: Maybe Int
, setCompile :: Bool
, ovewrwiteVer :: Maybe Version
, isolateDir :: Maybe FilePath
, cabalProject :: Maybe FilePath
, cabalProjectLocal :: Maybe FilePath
, patchDir :: Maybe FilePath
, targetGHCs :: [ToolVersion]
}
---------------
--[ Parsers ]--
---------------
compileP :: Parser CompileCommand
compileP = subparser
( command
"ghc"
( CompileGHC
<$> info
(ghcCompileOpts <**> helper)
( progDesc "Compile GHC from source"
<> footerDoc (Just $ text compileFooter)
)
)
<> command
"hls"
( CompileHLS
<$> info
(hlsCompileOpts <**> helper)
( progDesc "Compile HLS from source"
<> footerDoc (Just $ text compileHLSFooter)
)
)
)
where
compileFooter = [s|Discussion:
Compiles and installs the specified GHC version into
a self-contained "~/.ghcup/ghc/<ghcver>" directory
and symlinks the ghc binaries to "~/.ghcup/bin/<binary>-<ghcver>".
This also allows building a cross-compiler. Consult the documentation
first: <https://gitlab.haskell.org/ghc/ghc/-/wikis/building/cross-compiling#configuring-the-build>
ENV variables:
Various toolchain variables will be passed onto the ghc build system,
such as: CC, LD, OBJDUMP, NM, AR, RANLIB.
Examples:
# compile from known version
ghcup compile ghc -j 4 -v 8.4.2 -b 8.2.2
# compile from git commit/reference
ghcup compile ghc -j 4 -g master -b 8.2.2
# specify path to bootstrap ghc
ghcup compile ghc -j 4 -v 8.4.2 -b /usr/bin/ghc-8.2.2
# build cross compiler
ghcup compile ghc -j 4 -v 8.4.2 -b 8.2.2 -x armv7-unknown-linux-gnueabihf --config $(pwd)/build.mk -- --enable-unregisterised|]
compileHLSFooter = [s|Discussion:
Compiles and installs the specified HLS version.
The last argument is a list of GHC versions to compile for.
These need to be available in PATH prior to compilation.
Examples:
ghcup compile hls -v 1.4.0 -j 12 8.10.5 8.10.7 9.0.1|]
ghcCompileOpts :: Parser GHCCompileOptions
ghcCompileOpts =
GHCCompileOptions
<$> ((Left <$> option
(eitherReader
(first (const "Not a valid version") . version . T.pack)
)
(short 'v' <> long "version" <> metavar "VERSION" <> help
"The tool version to compile"
)
) <|>
(Right <$> (GitBranch <$> option
str
(short 'g' <> long "git-ref" <> metavar "GIT_REFERENCE" <> help
"The git commit/branch/ref to build from"
) <*>
optional (option str (short 'r' <> long "repository" <> metavar "GIT_REPOSITORY" <> help "The git repository to build from (defaults to GHC upstream)"))
)))
<*> option
(eitherReader
(\x ->
(bimap (const "Not a valid version") Left . version . T.pack $ x) <|> (if isPathSeparator (head x) then pure $ Right x else Left "Not an absolute Path")
)
)
( short 'b'
<> long "bootstrap-ghc"
<> metavar "BOOTSTRAP_GHC"
<> help
"The GHC version (or full path) to bootstrap with (must be installed)"
)
<*> optional
(option
(eitherReader (readEither @Int))
(short 'j' <> long "jobs" <> metavar "JOBS" <> help
"How many jobs to use for make"
)
)
<*> optional
(option
str
(short 'c' <> long "config" <> metavar "CONFIG" <> help
"Absolute path to build config file"
)
)
<*> optional
(option
str
(short 'p' <> long "patchdir" <> metavar "PATCH_DIR" <> help
"Absolute path to patch directory (applies all .patch and .diff files in order using -p1)"
)
)
<*> optional
(option
str
(short 'x' <> long "cross-target" <> metavar "CROSS_TARGET" <> help
"Build cross-compiler for this platform"
)
)
<*> many (argument str (metavar "CONFIGURE_ARGS" <> help "Additional arguments to configure, prefix with '-- ' (longopts)"))
<*> flag
False
True
(long "set" <> help
"Set as active version after install"
)
<*> optional
(option
(eitherReader
(first (const "Not a valid version") . version . T.pack)
)
(short 'o' <> long "overwrite-version" <> metavar "OVERWRITE_VERSION" <> help
"Allows to overwrite the finally installed VERSION with a different one, e.g. when you build 8.10.4 with your own patches, you might want to set this to '8.10.4-p1'"
)
)
<*> optional
(option
str
(short 'f' <> long "flavour" <> metavar "BUILD_FLAVOUR" <> help
"Set the compile build flavour (this value depends on the build system type: 'make' vs 'hadrian')"
)
)
<*> switch
(long "hadrian" <> help "Use the hadrian build system instead of make (only git versions seem to be properly supported atm)"
)
<*> optional
(option
(eitherReader isolateParser)
( short 'i'
<> long "isolate"
<> metavar "DIR"
<> help "install in an isolated directory instead of the default one, no symlinks to this installation will be made"
)
)
hlsCompileOpts :: Parser HLSCompileOptions
hlsCompileOpts =
HLSCompileOptions
<$> ((Left <$> option
(eitherReader
(first (const "Not a valid version") . version . T.pack)
)
(short 'v' <> long "version" <> metavar "VERSION" <> help
"The tool version to compile"
)
) <|>
(Right <$> (GitBranch <$> option
str
(short 'g' <> long "git-ref" <> metavar "GIT_REFERENCE" <> help
"The git commit/branch/ref to build from"
) <*>
optional (option str (short 'r' <> long "repository" <> metavar "GIT_REPOSITORY" <> help "The git repository to build from (defaults to GHC upstream)"))
)))
<*> optional
(option
(eitherReader (readEither @Int))
(short 'j' <> long "jobs" <> metavar "JOBS" <> help
"How many jobs to use for make"
)
)
<*> flag
False
True
(long "set" <> help
"Set as active version after install"
)
<*> optional
(option
(eitherReader
(first (const "Not a valid version") . version . T.pack)
)
(short 'o' <> long "overwrite-version" <> metavar "OVERWRITE_VERSION" <> help
"Allows to overwrite the finally installed VERSION with a different one, e.g. when you build 8.10.4 with your own patches, you might want to set this to '8.10.4-p1'"
)
)
<*> optional
(option
(eitherReader isolateParser)
( short 'i'
<> long "isolate"
<> metavar "DIR"
<> help "install in an isolated directory instead of the default one, no symlinks to this installation will be made"
)
)
<*> optional
(option
str
(long "cabal-project" <> metavar "CABAL_PROJECT" <> help
"If relative, specifies the path to cabal.project inside the unpacked HLS tarball/checkout. If absolute, will copy the file over."
)
)
<*> optional
(option
(eitherReader absolutePathParser)
(long "cabal-project-local" <> metavar "CABAL_PROJECT_LOCAL" <> help
"Absolute path to a cabal.project.local to be used for the build. Will be copied over."
)
)
<*> optional
(option
(eitherReader absolutePathParser)
(short 'p' <> long "patchdir" <> metavar "PATCH_DIR" <> help
"Absolute path to patch directory (applies all .patch and .diff files in order using -p1)"
)
)
<*> some (toolVersionArgument Nothing (Just GHC))
---------------------------
--[ Effect interpreters ]--
---------------------------
type GHCEffects = '[ AlreadyInstalled
, BuildFailed
, DigestError
, GPGError
, DownloadFailed
, GHCupSetError
, NoDownload
, NotFoundInPATH
, PatchFailed
, UnknownArchive
, TarDirDoesNotExist
, NotInstalled
, DirNotEmpty
, ArchiveResult
, FileDoesNotExistError
, HadrianNotFound
, InvalidBuildConfig
, ProcessError
, CopyError
, BuildFailed
]
type HLSEffects = '[ AlreadyInstalled
, BuildFailed
, DigestError
, GPGError
, DownloadFailed
, GHCupSetError
, NoDownload
, NotFoundInPATH
, PatchFailed
, UnknownArchive
, TarDirDoesNotExist
, TagNotFound
, NextVerNotFound
, NoToolVersionSet
, NotInstalled
, DirNotEmpty
, ArchiveResult
]
runCompileGHC :: (MonadUnliftIO m, MonadIO m)
=> (ReaderT AppState m (VEither GHCEffects a) -> m (VEither GHCEffects a))
-> Excepts GHCEffects (ResourceT (ReaderT AppState m)) a
-> m (VEither GHCEffects a)
runCompileGHC runAppState =
runAppState
. runResourceT
. runE
@GHCEffects
runCompileHLS :: (MonadUnliftIO m, MonadIO m)
=> (ReaderT AppState m (VEither HLSEffects a) -> m (VEither HLSEffects a))
-> Excepts HLSEffects (ResourceT (ReaderT AppState m)) a
-> m (VEither HLSEffects a)
runCompileHLS runAppState =
runAppState
. runResourceT
. runE
@HLSEffects
------------------
--[ Entrypoint ]--
------------------
compile :: ( Monad m
, MonadMask m
, MonadUnliftIO m
, MonadFail m
)
=> CompileCommand
-> Settings
-> (forall eff a . ReaderT AppState m (VEither eff a) -> m (VEither eff a))
-> (ReaderT LeanAppState m () -> m ())
-> m ExitCode
compile compileCommand settings runAppState runLogger = do
VRight Dirs{ .. } <- runAppState (VRight <$> getDirs)
case compileCommand of
(CompileHLS HLSCompileOptions { .. }) -> do
runCompileHLS runAppState (do
case targetHLS of
Left targetVer -> do
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
let vi = getVersionInfo targetVer HLS dls
forM_ (_viPreCompile =<< vi) $ \msg -> do
lift $ logInfo msg
lift $ logInfo
"...waiting for 5 seconds, you can still abort..."
liftIO $ threadDelay 5000000 -- for compilation, give the user a sec to intervene
Right _ -> pure ()
ghcs <- liftE $ forM targetGHCs (\ghc -> fmap (_tvVersion . fst) . fromVersion (Just ghc) $ GHC)
targetVer <- liftE $ compileHLS
targetHLS
ghcs
jobs
ovewrwiteVer
isolateDir
cabalProject
cabalProjectLocal
patchDir
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
let vi = getVersionInfo targetVer HLS dls
when setCompile $ void $ liftE $
setHLS targetVer
pure (vi, targetVer)
)
>>= \case
VRight (vi, tv) -> do
runLogger $ logInfo
"HLS successfully compiled and installed"
forM_ (_viPostInstall =<< vi) $ \msg ->
runLogger $ logInfo msg
liftIO $ putStr (T.unpack $ prettyVer tv)
pure ExitSuccess
VLeft err@(V (BuildFailed tmpdir _)) -> do
case keepDirs settings of
Never -> runLogger $ logError $ T.pack $ prettyShow err
_ -> runLogger (logError $ T.pack (prettyShow err) <> "\n" <>
"Check the logs at " <> T.pack logsDir <> " and the build directory "
<> T.pack tmpdir <> " for more clues." <> "\n" <>
"Make sure to clean up " <> T.pack tmpdir <> " afterwards.")
pure $ ExitFailure 9
VLeft e -> do
runLogger $ logError $ T.pack $ prettyShow e
pure $ ExitFailure 9
(CompileGHC GHCCompileOptions { hadrian = True, crossTarget = Just _ }) -> do
runLogger $ logError "Hadrian cross compile support is not yet implemented!"
pure $ ExitFailure 9
(CompileGHC GHCCompileOptions {..}) ->
runCompileGHC runAppState (do
case targetGhc of
Left targetVer -> do
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
let vi = getVersionInfo targetVer GHC dls
forM_ (_viPreCompile =<< vi) $ \msg -> do
lift $ logInfo msg
lift $ logInfo
"...waiting for 5 seconds, you can still abort..."
liftIO $ threadDelay 5000000 -- for compilation, give the user a sec to intervene
Right _ -> pure ()
targetVer <- liftE $ compileGHC
(first (GHCTargetVersion crossTarget) targetGhc)
ovewrwiteVer
bootstrapGhc
jobs
buildConfig
patchDir
addConfArgs
buildFlavour
hadrian
isolateDir
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
let vi = getVersionInfo (_tvVersion targetVer) GHC dls
when setCompile $ void $ liftE $
setGHC targetVer SetGHCOnly
pure (vi, targetVer)
)
>>= \case
VRight (vi, tv) -> do
runLogger $ logInfo
"GHC successfully compiled and installed"
forM_ (_viPostInstall =<< vi) $ \msg ->
runLogger $ logInfo msg
liftIO $ putStr (T.unpack $ tVerToText tv)
pure ExitSuccess
VLeft (V (AlreadyInstalled _ v)) -> do
runLogger $ logWarn $
"GHC ver " <> prettyVer v <> " already installed; if you really want to reinstall it, you may want to run 'ghcup install ghc --force " <> prettyVer v <> "'"
pure ExitSuccess
VLeft (V (DirNotEmpty fp)) -> do
runLogger $ logWarn $
"Install directory " <> T.pack fp <> " is not empty. Use 'ghcup install ghc --isolate " <> T.pack fp <> " --force ..." <> "' to install regardless."
pure $ ExitFailure 3
VLeft err@(V (BuildFailed tmpdir _)) -> do
case keepDirs settings of
Never -> runLogger $ logError $ T.pack $ prettyShow err
_ -> runLogger (logError $ T.pack (prettyShow err) <> "\n" <>
"Check the logs at " <> T.pack logsDir <> " and the build directory "
<> T.pack tmpdir <> " for more clues." <> "\n" <>
"Make sure to clean up " <> T.pack tmpdir <> " afterwards.")
pure $ ExitFailure 9
VLeft e -> do
runLogger $ logError $ T.pack $ prettyShow e
pure $ ExitFailure 9

View File

@@ -0,0 +1,187 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE RankNTypes #-}
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
#if !MIN_VERSION_base(4,13,0)
import Control.Monad.Fail ( MonadFail )
#endif
import Control.Exception ( displayException )
import Control.Monad.Reader
import Control.Monad.Trans.Resource
import Data.Functor
import Data.Maybe
import Haskus.Utils.Variant.Excepts
import Options.Applicative hiding ( style )
import Options.Applicative.Help.Pretty ( text )
import Prelude hiding ( appendFile )
import System.Exit
import qualified Data.Text as T
import qualified Data.ByteString.UTF8 as UTF8
import qualified Data.Yaml.Aeson as Y
import Control.Exception.Safe (MonadMask)
----------------
--[ Commands ]--
----------------
data ConfigCommand
= ShowConfig
| SetConfig String (Maybe String)
| InitConfig
---------------
--[ Parsers ]--
---------------
configP :: Parser ConfigCommand
configP = subparser
( command "init" initP
<> command "set" setP -- [set] KEY VALUE at help lhs
<> command "show" showP
)
<|> argsP -- add show for a single option
<|> pure ShowConfig
where
initP = info (pure InitConfig) (progDesc "Write default config to ~/.ghcup/config.yaml")
showP = info (pure ShowConfig) (progDesc "Show current config (default)")
setP = info argsP (progDesc "Set config KEY to VALUE (or specify as single json value)" <> footerDoc (Just $ text configSetFooter))
argsP = SetConfig <$> argument str (metavar "<JSON_VALUE | YAML_KEY>") <*> optional (argument str (metavar "YAML_VALUE"))
--------------
--[ Footer ]--
--------------
configFooter :: String
configFooter = [s|Examples:
# show current config
ghcup config
# initialize config
ghcup config init
# set <key> <value> configuration pair
ghcup config set <key> <value>|]
configSetFooter :: String
configSetFooter = [s|Examples:
# disable caching
ghcup config set cache false
# switch downloader to wget
ghcup config set downloader Wget
# set mirror for ghcup metadata
ghcup config set '{url-source: { OwnSource: "<url>"}}'|]
-----------------
--[ Utilities ]--
-----------------
formatConfig :: UserSettings -> String
formatConfig = UTF8.toString . Y.encode
updateSettings :: Monad m => UTF8.ByteString -> Settings -> Excepts '[JSONError] m Settings
updateSettings config' settings = do
settings' <- lE' (JSONDecodeError . displayException) . Y.decodeEither' $ config'
pure $ mergeConf settings' settings
where
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
verbose' = fromMaybe verbose uVerbose
urlSource' = fromMaybe urlSource uUrlSource
noNetwork' = fromMaybe noNetwork uNoNetwork
gpgSetting' = fromMaybe gpgSetting uGPGSetting
in Settings cache' metaCache' noVerify' keepDirs' downloader' verbose' urlSource' noNetwork' gpgSetting' noColor
------------------
--[ Entrypoint ]--
------------------
config :: ( Monad m
, MonadMask m
, MonadUnliftIO m
, MonadFail m
)
=> ConfigCommand
-> Settings
-> KeyBindings
-> (ReaderT LeanAppState m () -> m ())
-> m ExitCode
config configCommand settings keybindings runLogger = case configCommand of
InitConfig -> do
path <- getConfigFilePath
liftIO $ writeFile path $ formatConfig $ fromSettings settings (Just keybindings)
runLogger $ logDebug $ "config.yaml initialized at " <> T.pack path
pure ExitSuccess
ShowConfig -> do
liftIO $ putStrLn $ formatConfig $ fromSettings settings (Just keybindings)
pure ExitSuccess
(SetConfig k (Just v)) ->
case v of
"" -> do
runLogger $ logError "Empty values are not allowed"
pure $ ExitFailure 55
_ -> doConfig (k <> ": " <> v <> "\n")
(SetConfig json Nothing) -> doConfig json
where
doConfig val = do
r <- runE @'[JSONError] $ do
settings' <- updateSettings (UTF8.fromString val) settings
path <- liftIO getConfigFilePath
liftIO $ writeFile path $ formatConfig $ fromSettings settings' (Just keybindings)
lift $ runLogger $ logDebug $ T.pack $ show settings'
pure ()
case r of
VRight _ -> pure ExitSuccess
VLeft (V (JSONDecodeError e)) -> do
runLogger $ logError $ "Error decoding config: " <> T.pack e
pure $ ExitFailure 65
VLeft _ -> pure $ ExitFailure 65

View File

@@ -0,0 +1,119 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE RankNTypes #-}
module GHCup.OptParse.DInfo where
import GHCup
import GHCup.Errors
import GHCup.Version
import GHCup.Types
import GHCup.Utils.Prelude
import GHCup.Utils.Dirs
import GHCup.Utils.Logger
#if !MIN_VERSION_base(4,13,0)
import Control.Monad.Fail ( MonadFail )
#endif
import Control.Monad.Reader
import Control.Monad.Trans.Resource
import Data.Functor
import Data.Maybe
import Haskus.Utils.Variant.Excepts
import Options.Applicative hiding ( style )
import Prelude hiding ( appendFile )
import System.Exit
import Text.PrettyPrint.HughesPJClass ( prettyShow )
import qualified Data.Text as T
import Control.Exception.Safe (MonadMask)
import GHCup.Utils.File
import Language.Haskell.TH
-----------------
--[ Utilities ]--
-----------------
describe_result :: String
describe_result = $( LitE . StringL <$>
runIO (do
CapturedProcess{..} <- do
dirs <- liftIO getAllDirs
let settings = AppState (defaultSettings { noNetwork = True })
dirs
defaultKeyBindings
flip runReaderT settings $ executeOut "git" ["describe"] Nothing
case _exitCode of
ExitSuccess -> pure . T.unpack . decUTF8Safe' $ _stdOut
ExitFailure _ -> pure numericVer
)
)
prettyDebugInfo :: DebugInfo -> String
prettyDebugInfo DebugInfo {..} = "Debug Info" <> "\n" <>
"==========" <> "\n" <>
"GHCup base dir: " <> diBaseDir <> "\n" <>
"GHCup bin dir: " <> diBinDir <> "\n" <>
"GHCup GHC directory: " <> diGHCDir <> "\n" <>
"GHCup cache directory: " <> diCacheDir <> "\n" <>
"Architecture: " <> prettyShow diArch <> "\n" <>
"Platform: " <> prettyShow diPlatform <> "\n" <>
"Version: " <> describe_result
---------------------------
--[ Effect interpreters ]--
---------------------------
type DInfoEffects = '[ NoCompatiblePlatform , NoCompatibleArch , DistroNotFound ]
runDebugInfo :: (ReaderT env m (VEither DInfoEffects a) -> m (VEither DInfoEffects a))
-> Excepts DInfoEffects (ReaderT env m) a
-> m (VEither DInfoEffects a)
runDebugInfo runAppState =
runAppState
. runE
@DInfoEffects
------------------
--[ Entrypoint ]--
------------------
dinfo :: ( Monad m
, MonadMask m
, MonadUnliftIO m
, MonadFail m
, Alternative m
)
=> (ReaderT AppState m (VEither DInfoEffects DebugInfo)
-> m (VEither DInfoEffects DebugInfo))
-> (ReaderT LeanAppState m () -> m ())
-> m ExitCode
dinfo runAppState runLogger = do
runDebugInfo runAppState (liftE getDebugInfo)
>>= \case
VRight di -> do
liftIO $ putStrLn $ prettyDebugInfo di
pure ExitSuccess
VLeft e -> do
runLogger $ logError $ T.pack $ prettyShow e
pure $ ExitFailure 8

View File

@@ -0,0 +1,143 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE RankNTypes #-}
module GHCup.OptParse.GC where
import GHCup
import GHCup.Errors
import GHCup.Types
import GHCup.Utils.Logger
import GHCup.Utils.String.QQ
#if !MIN_VERSION_base(4,13,0)
import Control.Monad.Fail ( MonadFail )
#endif
import Control.Monad.Reader
import Control.Monad.Trans.Resource
import Data.Functor
import Haskus.Utils.Variant.Excepts
import Options.Applicative hiding ( style )
import Prelude hiding ( appendFile )
import System.Exit
import Text.PrettyPrint.HughesPJClass ( prettyShow )
import qualified Data.Text as T
import Control.Exception.Safe (MonadMask)
---------------
--[ Options ]--
---------------
data GCOptions = GCOptions
{ gcOldGHC :: Bool
, gcProfilingLibs :: Bool
, gcShareDir :: Bool
, gcHLSNoGHC :: Bool
, gcCache :: Bool
, gcTmp :: Bool
}
---------------
--[ Parsers ]--
---------------
gcP :: Parser GCOptions
gcP =
GCOptions
<$>
switch
(short 'o' <> long "ghc-old" <> help "Remove GHC versions marked as 'old'")
<*>
switch
(short 'p' <> long "profiling-libs" <> help "Remove profiling libs of GHC versions")
<*>
switch
(short 's' <> long "share-dir" <> help "Remove GHC share directories (documentation)")
<*>
switch
(short 'h' <> long "hls-no-ghc" <> help "Remove HLS versions that don't have a corresponding installed GHC version")
<*>
switch
(short 'c' <> long "cache" <> help "GC the GHCup cache")
<*>
switch
(short 't' <> long "tmpdirs" <> help "Remove tmpdir leftovers")
--------------
--[ Footer ]--
--------------
gcFooter :: String
gcFooter = [s|Discussion:
Performs garbage collection. If no switches are specified, does nothing.|]
---------------------------
--[ Effect interpreters ]--
---------------------------
type GCEffects = '[ NotInstalled ]
runGC :: MonadUnliftIO m
=> (ReaderT AppState m (VEither GCEffects a) -> m (VEither GCEffects a))
-> Excepts GCEffects (ResourceT (ReaderT AppState m)) a
-> m (VEither GCEffects a)
runGC runAppState =
runAppState
. runResourceT
. runE
@GCEffects
------------------
--[ Entrypoint ]--
------------------
gc :: ( Monad m
, MonadMask m
, MonadUnliftIO m
, MonadFail m
)
=> GCOptions
-> (forall a. ReaderT AppState m (VEither GCEffects a) -> m (VEither GCEffects a))
-> (ReaderT LeanAppState m () -> m ())
-> m ExitCode
gc GCOptions{..} runAppState runLogger = runGC runAppState (do
when gcOldGHC rmOldGHC
lift $ when gcProfilingLibs rmProfilingLibs
lift $ when gcShareDir rmShareDir
lift $ when gcHLSNoGHC rmHLSNoGHC
lift $ when gcCache rmCache
lift $ when gcTmp rmTmp
) >>= \case
VRight _ -> do
pure ExitSuccess
VLeft e -> do
runLogger $ logError $ T.pack $ prettyShow e
pure $ ExitFailure 27

View File

@@ -0,0 +1,464 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE DuplicateRecordFields #-}
module GHCup.OptParse.Install where
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 Codec.Archive
#if !MIN_VERSION_base(4,13,0)
import Control.Monad.Fail ( MonadFail )
#endif
import Control.Monad.Reader
import Control.Monad.Trans.Resource
import Data.Either
import Data.Functor
import Data.Maybe
import Data.Versions hiding ( str )
import Haskus.Utils.Variant.Excepts
import Options.Applicative hiding ( style )
import Options.Applicative.Help.Pretty ( text )
import Prelude hiding ( appendFile )
import System.Exit
import Text.PrettyPrint.HughesPJClass ( prettyShow )
import URI.ByteString
import qualified Data.Text as T
----------------
--[ Commands ]--
----------------
data InstallCommand = InstallGHC InstallOptions
| InstallCabal InstallOptions
| InstallHLS InstallOptions
| InstallStack InstallOptions
---------------
--[ Options ]--
---------------
data InstallOptions = InstallOptions
{ instVer :: Maybe ToolVersion
, instPlatform :: Maybe PlatformRequest
, instBindist :: Maybe URI
, instSet :: Bool
, isolateDir :: Maybe FilePath
, forceInstall :: Bool
}
---------------
--[ Footers ]--
---------------
installCabalFooter :: String
installCabalFooter = [s|Discussion:
Installs the specified cabal-install version (or a recommended default one)
into "~/.ghcup/bin", so it can be overwritten by later
"cabal install cabal-install", which installs into "~/.cabal/bin" by
default. Make sure to set up your PATH appropriately, so the cabal
installation takes precedence.|]
---------------
--[ Parsers ]--
---------------
installParser :: Parser (Either InstallCommand InstallOptions)
installParser =
(Left <$> subparser
( command
"ghc"
( InstallGHC
<$> info
(installOpts (Just GHC) <**> helper)
( progDesc "Install GHC"
<> footerDoc (Just $ text installGHCFooter)
)
)
<> command
"cabal"
( InstallCabal
<$> info
(installOpts (Just Cabal) <**> helper)
( progDesc "Install Cabal"
<> footerDoc (Just $ text installCabalFooter)
)
)
<> command
"hls"
( InstallHLS
<$> info
(installOpts (Just HLS) <**> helper)
( progDesc "Install haskell-language-server"
<> footerDoc (Just $ text installHLSFooter)
)
)
<> command
"stack"
( InstallStack
<$> info
(installOpts (Just Stack) <**> helper)
( progDesc "Install stack"
<> footerDoc (Just $ text installStackFooter)
)
)
)
)
<|> (Right <$> installOpts Nothing)
where
installHLSFooter :: String
installHLSFooter = [s|Discussion:
Installs haskell-language-server binaries and wrapper
into "~/.ghcup/bin"
Examples:
# install recommended HLS
ghcup install hls|]
installStackFooter :: String
installStackFooter = [s|Discussion:
Installs stack binaries into "~/.ghcup/bin"
Examples:
# install recommended Stack
ghcup install stack|]
installGHCFooter :: String
installGHCFooter = [s|Discussion:
Installs the specified GHC version (or a recommended default one) into
a self-contained "~/.ghcup/ghc/<ghcver>" directory
and symlinks the ghc binaries to "~/.ghcup/bin/<binary>-<ghcver>".
Examples:
# install recommended GHC
ghcup install ghc
# install latest GHC
ghcup install ghc latest
# install GHC 8.10.2
ghcup install ghc 8.10.2
# install GHC head fedora bindist
ghcup install ghc -u https://gitlab.haskell.org/api/v4/projects/1/jobs/artifacts/master/raw/ghc-x86_64-fedora27-linux.tar.xz?job=validate-x86_64-linux-fedora27 head|]
installOpts :: Maybe Tool -> Parser InstallOptions
installOpts tool =
(\p (u, v) b is f -> InstallOptions v p u b is f)
<$> optional
(option
(eitherReader platformParser)
( short 'p'
<> long "platform"
<> metavar "PLATFORM"
<> help
"Override for platform (triple matching ghc tarball names), e.g. x86_64-fedora27-linux"
)
)
<*> ( ( (,)
<$> optional
(option
(eitherReader bindistParser)
(short 'u' <> long "url" <> metavar "BINDIST_URL" <> help
"Install the specified version from this bindist"
)
)
<*> (Just <$> toolVersionArgument Nothing tool)
)
<|> pure (Nothing, Nothing)
)
<*> flag
False
True
(long "set" <> help
"Set as active version after install"
)
<*> optional
(option
(eitherReader isolateParser)
( short 'i'
<> long "isolate"
<> metavar "DIR"
<> help "install in an isolated dir instead of the default one"
)
)
<*> switch
(short 'f' <> long "force" <> help "Force install")
--------------
--[ Footer ]--
--------------
installToolFooter :: String
installToolFooter = [s|Discussion:
Installs GHC or cabal. When no command is given, installs GHC
with the specified version/tag.
It is recommended to always specify a subcommand (ghc/cabal/hls/stack).|]
---------------------------
--[ Effect interpreters ]--
---------------------------
type InstallEffects = '[ AlreadyInstalled
, UnknownArchive
, ArchiveResult
, FileDoesNotExistError
, CopyError
, NotInstalled
, DirNotEmpty
, NoDownload
, NotInstalled
, BuildFailed
, TagNotFound
, DigestError
, GPGError
, DownloadFailed
, TarDirDoesNotExist
, NextVerNotFound
, NoToolVersionSet
, FileAlreadyExistsError
, ProcessError
]
runInstTool :: AppState
-> Maybe PlatformRequest
-> Excepts InstallEffects (ResourceT (ReaderT AppState IO)) a
-> IO (VEither InstallEffects a)
runInstTool appstate' mInstPlatform =
flip runReaderT (maybe appstate' (\x -> appstate'{ pfreq = x } :: AppState) mInstPlatform)
. runResourceT
. runE
@InstallEffects
-------------------
--[ Entrypoints ]--
-------------------
install :: Either InstallCommand InstallOptions -> Settings -> IO AppState -> (ReaderT LeanAppState IO () -> IO ()) -> IO ExitCode
install installCommand settings getAppState' runLogger = case installCommand of
(Right iopts) -> do
runLogger (logWarn "This is an old-style command for installing GHC. Use 'ghcup install ghc' instead.")
installGHC iopts
(Left (InstallGHC iopts)) -> installGHC iopts
(Left (InstallCabal iopts)) -> installCabal iopts
(Left (InstallHLS iopts)) -> installHLS iopts
(Left (InstallStack iopts)) -> installStack iopts
where
installGHC :: InstallOptions -> IO ExitCode
installGHC InstallOptions{..} = do
s'@AppState{ dirs = Dirs{ .. } } <- liftIO getAppState'
(case instBindist of
Nothing -> runInstTool s' instPlatform $ do
(v, vi) <- liftE $ fromVersion instVer GHC
liftE $ installGHCBin
(_tvVersion v)
isolateDir
forceInstall
when instSet $ void $ liftE $ setGHC v SetGHCOnly
pure vi
Just uri -> do
runInstTool s'{ settings = settings {noVerify = True}} instPlatform $ do
(v, vi) <- liftE $ fromVersion instVer GHC
liftE $ installGHCBindist
(DownloadInfo uri (Just $ RegexDir "ghc-.*") "")
(_tvVersion v)
isolateDir
forceInstall
when instSet $ void $ liftE $ setGHC v SetGHCOnly
pure vi
)
>>= \case
VRight vi -> do
runLogger $ logInfo "GHC installation successful"
forM_ (_viPostInstall =<< vi) $ \msg ->
runLogger $ logInfo msg
pure ExitSuccess
VLeft (V (AlreadyInstalled _ v)) -> do
runLogger $ logWarn $
"GHC ver " <> prettyVer v <> " already installed; if you really want to reinstall it, you may want to run 'ghcup install ghc --force " <> prettyVer v <> "'"
pure ExitSuccess
VLeft (V (DirNotEmpty fp)) -> do
runLogger $ logWarn $
"Install directory " <> T.pack fp <> " is not empty. Use 'ghcup install ghc --isolate " <> T.pack fp <> " --force ..." <> "' to install regardless."
pure $ ExitFailure 3
VLeft err@(V (BuildFailed tmpdir _)) -> do
case keepDirs settings of
Never -> runLogger (logError $ T.pack $ prettyShow err)
_ -> runLogger (logError $ T.pack (prettyShow err) <> "\n" <>
"Check the logs at " <> T.pack logsDir <> " and the build directory " <> T.pack tmpdir <> " for more clues." <> "\n" <>
"Make sure to clean up " <> T.pack tmpdir <> " afterwards.")
pure $ ExitFailure 3
VLeft e -> do
runLogger $ do
logError $ T.pack $ prettyShow e
logError $ "Also check the logs in " <> T.pack logsDir
pure $ ExitFailure 3
installCabal :: InstallOptions -> IO ExitCode
installCabal InstallOptions{..} = do
s'@AppState{ dirs = Dirs{ .. } } <- liftIO getAppState'
(case instBindist of
Nothing -> runInstTool s' instPlatform $ do
(v, vi) <- liftE $ fromVersion instVer Cabal
liftE $ installCabalBin
(_tvVersion v)
isolateDir
forceInstall
pure vi
Just uri -> do
runInstTool s'{ settings = settings { noVerify = True}} instPlatform $ do
(v, vi) <- liftE $ fromVersion instVer Cabal
liftE $ installCabalBindist
(DownloadInfo uri Nothing "")
(_tvVersion v)
isolateDir
forceInstall
pure vi
)
>>= \case
VRight vi -> do
runLogger $ logInfo "Cabal installation successful"
forM_ (_viPostInstall =<< vi) $ \msg ->
runLogger $ logInfo msg
pure ExitSuccess
VLeft (V (AlreadyInstalled _ v)) -> do
runLogger $ logWarn $
"Cabal ver " <> prettyVer v <> " already installed; if you really want to reinstall it, you may want to run 'ghcup install cabal --force " <> prettyVer v <> "'"
pure ExitSuccess
VLeft (V (FileAlreadyExistsError fp)) -> do
runLogger $ logWarn $
"File " <> T.pack fp <> " already exists. Use 'ghcup install cabal --isolate " <> T.pack fp <> " --force ..." <> "' if you want to overwrite."
pure $ ExitFailure 3
VLeft e -> do
runLogger $ do
logError $ T.pack $ prettyShow e
logError $ "Also check the logs in " <> T.pack logsDir
pure $ ExitFailure 4
installHLS :: InstallOptions -> IO ExitCode
installHLS InstallOptions{..} = do
s'@AppState{ dirs = Dirs{ .. } } <- liftIO getAppState'
(case instBindist of
Nothing -> runInstTool s' instPlatform $ do
(v, vi) <- liftE $ fromVersion instVer HLS
liftE $ installHLSBin
(_tvVersion v)
isolateDir
forceInstall
pure vi
Just uri -> do
runInstTool s'{ settings = settings { noVerify = True}} instPlatform $ do
(v, vi) <- liftE $ fromVersion instVer HLS
liftE $ installHLSBindist
(DownloadInfo uri Nothing "")
(_tvVersion v)
isolateDir
forceInstall
pure vi
)
>>= \case
VRight vi -> do
runLogger $ logInfo "HLS installation successful"
forM_ (_viPostInstall =<< vi) $ \msg ->
runLogger $ logInfo msg
pure ExitSuccess
VLeft (V (AlreadyInstalled _ v)) -> do
runLogger $ logWarn $
"HLS ver "
<> prettyVer v
<> " already installed; if you really want to reinstall it, you may want to run 'ghcup install hls --force "
<> prettyVer v
<> "'"
pure ExitSuccess
VLeft (V (FileAlreadyExistsError fp)) -> do
runLogger $ logWarn $
"File " <> T.pack fp <> " already exists. Use 'ghcup install hls --isolate " <> T.pack fp <> " --force ..." <> "' if you want to overwrite."
pure $ ExitFailure 3
VLeft e -> do
runLogger $ do
logError $ T.pack $ prettyShow e
logError $ "Also check the logs in " <> T.pack logsDir
pure $ ExitFailure 4
installStack :: InstallOptions -> IO ExitCode
installStack InstallOptions{..} = do
s'@AppState{ dirs = Dirs{ .. } } <- liftIO getAppState'
(case instBindist of
Nothing -> runInstTool s' instPlatform $ do
(v, vi) <- liftE $ fromVersion instVer Stack
liftE $ installStackBin
(_tvVersion v)
isolateDir
forceInstall
pure vi
Just uri -> do
runInstTool s'{ settings = settings { noVerify = True}} instPlatform $ do
(v, vi) <- liftE $ fromVersion instVer Stack
liftE $ installStackBindist
(DownloadInfo uri Nothing "")
(_tvVersion v)
isolateDir
forceInstall
pure vi
)
>>= \case
VRight vi -> do
runLogger $ logInfo "Stack installation successful"
forM_ (_viPostInstall =<< vi) $ \msg ->
runLogger $ logInfo msg
pure ExitSuccess
VLeft (V (AlreadyInstalled _ v)) -> do
runLogger $ logWarn $
"Stack ver " <> prettyVer v <> " already installed; if you really want to reinstall it, you may want to run 'ghcup install stack --force " <> prettyVer v <> "'"
pure ExitSuccess
VLeft (V (FileAlreadyExistsError fp)) -> do
runLogger $ logWarn $
"File " <> T.pack fp <> " already exists. Use 'ghcup install stack --isolate " <> T.pack fp <> " --force ..." <> "' if you want to overwrite."
pure $ ExitFailure 3
VLeft e -> do
runLogger $ do
logError $ T.pack $ prettyShow e
logError $ "Also check the logs in " <> T.pack logsDir
pure $ ExitFailure 4

View File

@@ -0,0 +1,263 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE RankNTypes #-}
module GHCup.OptParse.List where
import GHCup
import GHCup.Utils.Prelude
import GHCup.Types
import GHCup.OptParse.Common
#if !MIN_VERSION_base(4,13,0)
import Control.Monad.Fail ( MonadFail )
#endif
import Control.Monad.Reader
import Control.Monad.Trans.Resource
import Data.Char
import Data.List ( intercalate, sort )
import Data.Functor
import Data.Maybe
import Data.Versions hiding ( str )
import Data.Void
import Options.Applicative hiding ( style )
import Prelude hiding ( appendFile )
import System.Exit
import System.Console.Pretty hiding ( color )
import qualified Data.Text as T
import qualified System.Console.Pretty as Pretty
import Control.Exception.Safe (MonadMask)
import qualified Text.Megaparsec as MP
import qualified Text.Megaparsec.Char as MPC
---------------
--[ Options ]--
---------------
data ListOptions = ListOptions
{ loTool :: Maybe Tool
, lCriteria :: Maybe ListCriteria
, lRawFormat :: Bool
}
---------------
--[ Parsers ]--
---------------
listOpts :: Parser ListOptions
listOpts =
ListOptions
<$> optional
(option
(eitherReader toolParser)
(short 't' <> long "tool" <> metavar "<ghc|cabal|hls|stack>" <> help
"Tool to list versions for. Default is all"
)
)
<*> optional
(option
(eitherReader criteriaParser)
( short 'c'
<> long "show-criteria"
<> metavar "<installed|set|available>"
<> help "Show only installed/set/available tool versions"
)
)
<*> switch
(short 'r' <> long "raw-format" <> help "More machine-parsable format"
)
-----------------
--[ Utilities ]--
-----------------
printListResult :: Bool -> Bool -> [ListResult] -> IO ()
printListResult no_color raw lr = do
let
color | raw || no_color = (\_ x -> x)
| otherwise = Pretty.color
let
printTag Recommended = color Green "recommended"
printTag Latest = color Yellow "latest"
printTag Prerelease = color Red "prerelease"
printTag (Base pvp'') = "base-" ++ T.unpack (prettyPVP pvp'')
printTag (UnknownTag t ) = t
printTag Old = ""
let
rows =
(\x -> if raw
then x
else [color Green "", "Tool", "Version", "Tags", "Notes"] : x
)
. fmap
(\ListResult {..} ->
let marks = if
| lSet -> (color Green (if isWindows then "IS" else "✔✔"))
| lInstalled -> (color Green (if isWindows then "I " else ""))
| otherwise -> (color Red (if isWindows then "X " else ""))
in
(if raw then [] else [marks])
++ [ fmap toLower . show $ lTool
, case lCross of
Nothing -> T.unpack . prettyVer $ lVer
Just c -> T.unpack (c <> "-" <> prettyVer lVer)
, intercalate "," (filter (/= "") . fmap printTag $ sort lTag)
, intercalate ","
$ (if hlsPowered
then [color Green "hls-powered"]
else mempty
)
++ (if fromSrc then [color Blue "compiled"] else mempty)
++ (if lStray then [color Yellow "stray"] else mempty)
++ (if lNoBindist
then [color Red "no-bindist"]
else mempty
)
]
)
$ lr
let cols =
foldr (\xs ys -> zipWith (:) xs ys) (replicate (length rows) []) rows
lengths = fmap (maximum . fmap strWidth) cols
padded = fmap (\xs -> zipWith padTo xs lengths) rows
forM_ padded $ \row -> putStrLn $ unwords row
where
padTo str' x =
let lstr = strWidth str'
add' = x - lstr
in if add' < 0 then str' else str' ++ replicate add' ' '
-- | Calculate the render width of a string, considering
-- wide characters (counted as double width), ANSI escape codes
-- (not counted), and line breaks (in a multi-line string, the longest
-- line determines the width).
strWidth :: String -> Int
strWidth =
maximum
. (0 :)
. map (foldr (\a b -> charWidth a + b) 0)
. lines
. stripAnsi
-- | Strip ANSI escape sequences from a string.
--
-- >>> stripAnsi "\ESC[31m-1\ESC[m"
-- "-1"
stripAnsi :: String -> String
stripAnsi s' =
case
MP.parseMaybe (many $ "" <$ MP.try ansi <|> pure <$> MP.anySingle) s'
of
Nothing -> error "Bad ansi escape" -- PARTIAL: should not happen
Just xs -> concat xs
where
-- This parses lots of invalid ANSI escape codes, but that should be fine
ansi =
MPC.string "\ESC[" *> digitSemicolons *> suffix MP.<?> "ansi" :: MP.Parsec
Void
String
Char
digitSemicolons = MP.takeWhileP Nothing (\c -> isDigit c || c == ';')
suffix = MP.oneOf ['A', 'B', 'C', 'D', 'H', 'J', 'K', 'f', 'm', 's', 'u']
-- | Get the designated render width of a character: 0 for a combining
-- character, 1 for a regular character, 2 for a wide character.
-- (Wide characters are rendered as exactly double width in apps and
-- fonts that support it.) (From Pandoc.)
charWidth :: Char -> Int
charWidth c = case c of
_ | c < '\x0300' -> 1
| c >= '\x0300' && c <= '\x036F' -> 0
| -- combining
c >= '\x0370' && c <= '\x10FC' -> 1
| c >= '\x1100' && c <= '\x115F' -> 2
| c >= '\x1160' && c <= '\x11A2' -> 1
| c >= '\x11A3' && c <= '\x11A7' -> 2
| c >= '\x11A8' && c <= '\x11F9' -> 1
| c >= '\x11FA' && c <= '\x11FF' -> 2
| c >= '\x1200' && c <= '\x2328' -> 1
| c >= '\x2329' && c <= '\x232A' -> 2
| c >= '\x232B' && c <= '\x2E31' -> 1
| c >= '\x2E80' && c <= '\x303E' -> 2
| c == '\x303F' -> 1
| c >= '\x3041' && c <= '\x3247' -> 2
| c >= '\x3248' && c <= '\x324F' -> 1
| -- ambiguous
c >= '\x3250' && c <= '\x4DBF' -> 2
| c >= '\x4DC0' && c <= '\x4DFF' -> 1
| c >= '\x4E00' && c <= '\xA4C6' -> 2
| c >= '\xA4D0' && c <= '\xA95F' -> 1
| c >= '\xA960' && c <= '\xA97C' -> 2
| c >= '\xA980' && c <= '\xABF9' -> 1
| c >= '\xAC00' && c <= '\xD7FB' -> 2
| c >= '\xD800' && c <= '\xDFFF' -> 1
| c >= '\xE000' && c <= '\xF8FF' -> 1
| -- ambiguous
c >= '\xF900' && c <= '\xFAFF' -> 2
| c >= '\xFB00' && c <= '\xFDFD' -> 1
| c >= '\xFE00' && c <= '\xFE0F' -> 1
| -- ambiguous
c >= '\xFE10' && c <= '\xFE19' -> 2
| c >= '\xFE20' && c <= '\xFE26' -> 1
| c >= '\xFE30' && c <= '\xFE6B' -> 2
| c >= '\xFE70' && c <= '\xFEFF' -> 1
| c >= '\xFF01' && c <= '\xFF60' -> 2
| c >= '\xFF61' && c <= '\x16A38' -> 1
| c >= '\x1B000' && c <= '\x1B001' -> 2
| c >= '\x1D000' && c <= '\x1F1FF' -> 1
| c >= '\x1F200' && c <= '\x1F251' -> 2
| c >= '\x1F300' && c <= '\x1F773' -> 1
| c >= '\x20000' && c <= '\x3FFFD' -> 2
| otherwise -> 1
------------------
--[ Entrypoint ]--
------------------
list :: ( Monad m
, MonadMask m
, MonadUnliftIO m
, MonadFail m
)
=> ListOptions
-> Bool
-> (ReaderT AppState m ExitCode -> m ExitCode)
-> m ExitCode
list ListOptions{..} no_color runAppState =
runAppState (do
l <- listVersions loTool lCriteria
liftIO $ printListResult no_color lRawFormat l
pure ExitSuccess
)

View File

@@ -0,0 +1,99 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE RankNTypes #-}
module GHCup.OptParse.Nuke where
import GHCup
import GHCup.Errors
import GHCup.Types
import GHCup.Utils.Logger
#if !MIN_VERSION_base(4,13,0)
import Control.Monad.Fail ( MonadFail )
#endif
import Control.Monad.Reader
import Control.Monad.Trans.Resource
import Data.Maybe
import Haskus.Utils.Variant.Excepts
import Options.Applicative hiding ( style )
import Prelude hiding ( appendFile )
import System.Exit
import Text.PrettyPrint.HughesPJClass ( prettyShow )
import qualified Data.Text as T
import Control.Exception.Safe (MonadMask)
import Control.DeepSeq
import Control.Exception
import Control.Concurrent (threadDelay)
---------------------------
--[ Effect interpreters ]--
---------------------------
type NukeEffects = '[ NotInstalled ]
runNuke :: AppState
-> Excepts NukeEffects (ReaderT AppState m) a
-> m (VEither NukeEffects a)
runNuke s' =
flip runReaderT s' . runE @NukeEffects
------------------
--[ Entrypoint ]--
------------------
nuke :: ( Monad m
, MonadMask m
, MonadUnliftIO m
, MonadFail m
)
=> IO AppState
-> (ReaderT LeanAppState m () -> m ())
-> m ExitCode
nuke appState runLogger = do
s' <- liftIO appState
void $ liftIO $ evaluate $ force s'
runNuke s' (do
lift $ logWarn "WARNING: This will remove GHCup and all installed components from your system."
lift $ logWarn "Waiting 10 seconds before commencing, if you want to cancel it, now would be the time."
liftIO $ threadDelay 10000000 -- wait 10s
lift $ logInfo "Initiating Nuclear Sequence 🚀🚀🚀"
lift $ logInfo "Nuking in 3...2...1"
lInstalled <- lift $ listVersions Nothing (Just ListInstalled)
forM_ lInstalled (liftE . rmTool)
lift rmGhcupDirs
) >>= \case
VRight leftOverFiles
| null leftOverFiles -> do
runLogger $ logInfo "Nuclear Annihilation complete!"
pure ExitSuccess
| otherwise -> do
runLogger $ logError "These Files have survived Nuclear Annihilation, you may remove them manually."
liftIO $ forM_ leftOverFiles putStrLn
pure ExitSuccess
VLeft e -> do
runLogger $ logError $ T.pack $ prettyShow e
pure $ ExitFailure 15

View File

@@ -0,0 +1,219 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE RankNTypes #-}
module GHCup.OptParse.Prefetch where
import GHCup
import GHCup.Errors
import GHCup.Types
import GHCup.Utils.Logger
import GHCup.OptParse.Common
import GHCup.Utils.String.QQ
#if !MIN_VERSION_base(4,13,0)
import Control.Monad.Fail ( MonadFail )
#endif
import Control.Monad.Reader
import Control.Monad.Trans.Resource
import Data.Functor
import Data.Maybe
import Haskus.Utils.Variant.Excepts
import Options.Applicative hiding ( style )
import Prelude hiding ( appendFile )
import System.Exit
import Text.PrettyPrint.HughesPJClass ( prettyShow )
import qualified Data.Text as T
import Control.Exception.Safe (MonadMask)
import GHCup.Utils.Prelude
import GHCup.Download (getDownloadsF)
----------------
--[ Commands ]--
----------------
data PrefetchCommand = PrefetchGHC PrefetchGHCOptions (Maybe ToolVersion)
| PrefetchCabal PrefetchOptions (Maybe ToolVersion)
| PrefetchHLS PrefetchOptions (Maybe ToolVersion)
| PrefetchStack PrefetchOptions (Maybe ToolVersion)
| PrefetchMetadata
---------------
--[ Options ]--
---------------
data PrefetchOptions = PrefetchOptions {
pfCacheDir :: Maybe FilePath
}
data PrefetchGHCOptions = PrefetchGHCOptions {
pfGHCSrc :: Bool
, pfGHCCacheDir :: Maybe FilePath
}
---------------
--[ Parsers ]--
---------------
prefetchP :: Parser PrefetchCommand
prefetchP = subparser
( command
"ghc"
(info
(PrefetchGHC
<$> (PrefetchGHCOptions
<$> ( switch (short 's' <> long "source" <> help "Download source tarball instead of bindist") <**> helper )
<*> optional (option str (short 'd' <> long "directory" <> help "directory to download into (default: ~/.ghcup/cache/)")))
<*> optional (toolVersionArgument Nothing (Just GHC)) )
( progDesc "Download GHC assets for installation")
)
<>
command
"cabal"
(info
(PrefetchCabal
<$> fmap PrefetchOptions (optional (option str (short 'd' <> long "directory" <> help "directory to download into (default: ~/.ghcup/cache/)")))
<*> ( optional (toolVersionArgument Nothing (Just Cabal)) <**> helper ))
( progDesc "Download cabal assets for installation")
)
<>
command
"hls"
(info
(PrefetchHLS
<$> fmap PrefetchOptions (optional (option str (short 'd' <> long "directory" <> help "directory to download into (default: ~/.ghcup/cache/)")))
<*> ( optional (toolVersionArgument Nothing (Just HLS)) <**> helper ))
( progDesc "Download HLS assets for installation")
)
<>
command
"stack"
(info
(PrefetchStack
<$> fmap PrefetchOptions (optional (option str (short 'd' <> long "directory" <> help "directory to download into (default: ~/.ghcup/cache/)")))
<*> ( optional (toolVersionArgument Nothing (Just Stack)) <**> helper ))
( progDesc "Download stack assets for installation")
)
<>
command
"metadata"
(PrefetchMetadata <$ info
helper
( progDesc "Download ghcup's metadata, needed for various operations")
)
)
--------------
--[ Footer ]--
--------------
prefetchFooter :: String
prefetchFooter = [s|Discussion:
Prefetches tools or assets into "~/.ghcup/cache" directory. This can
be then combined later with '--offline' flag, ensuring all assets that
are required for offline use have been prefetched.
Examples:
ghcup prefetch metadata
ghcup prefetch ghc 8.10.5
ghcup --offline install ghc 8.10.5|]
---------------------------
--[ Effect interpreters ]--
---------------------------
type PrefetchEffects = '[ TagNotFound
, NextVerNotFound
, NoToolVersionSet
, NoDownload
, DigestError
, GPGError
, DownloadFailed
, JSONError
, FileDoesNotExistError ]
runPrefetch :: MonadUnliftIO m
=> (ReaderT AppState m (VEither PrefetchEffects a) -> m (VEither PrefetchEffects a))
-> Excepts PrefetchEffects (ResourceT (ReaderT AppState m)) a
-> m (VEither PrefetchEffects a)
runPrefetch runAppState =
runAppState
. runResourceT
. runE
@PrefetchEffects
------------------
--[ Entrypoint ]--
------------------
prefetch :: ( Monad m
, MonadMask m
, MonadUnliftIO m
, MonadFail m
)
=> PrefetchCommand
-> (forall a. ReaderT AppState m (VEither PrefetchEffects a) -> m (VEither PrefetchEffects a))
-> (ReaderT LeanAppState m () -> m ())
-> m ExitCode
prefetch prefetchCommand runAppState runLogger =
runPrefetch runAppState (do
case prefetchCommand of
PrefetchGHC
(PrefetchGHCOptions pfGHCSrc pfCacheDir) mt -> do
forM_ pfCacheDir (liftIO . createDirRecursive')
(v, _) <- liftE $ fromVersion mt GHC
if pfGHCSrc
then liftE $ fetchGHCSrc (_tvVersion v) pfCacheDir
else liftE $ fetchToolBindist (_tvVersion v) GHC pfCacheDir
PrefetchCabal PrefetchOptions {pfCacheDir} mt -> do
forM_ pfCacheDir (liftIO . createDirRecursive')
(v, _) <- liftE $ fromVersion mt Cabal
liftE $ fetchToolBindist (_tvVersion v) Cabal pfCacheDir
PrefetchHLS PrefetchOptions {pfCacheDir} mt -> do
forM_ pfCacheDir (liftIO . createDirRecursive')
(v, _) <- liftE $ fromVersion mt HLS
liftE $ fetchToolBindist (_tvVersion v) HLS pfCacheDir
PrefetchStack PrefetchOptions {pfCacheDir} mt -> do
forM_ pfCacheDir (liftIO . createDirRecursive')
(v, _) <- liftE $ fromVersion mt Stack
liftE $ fetchToolBindist (_tvVersion v) Stack pfCacheDir
PrefetchMetadata -> do
_ <- liftE getDownloadsF
pure ""
) >>= \case
VRight _ -> do
pure ExitSuccess
VLeft e -> do
runLogger $ logError $ T.pack $ prettyShow e
pure $ ExitFailure 15

View File

@@ -0,0 +1,232 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE RankNTypes #-}
module GHCup.OptParse.Rm where
import GHCup
import GHCup.Errors
import GHCup.Types
import GHCup.Types.Optics
import GHCup.Utils
import GHCup.Utils.Logger
import GHCup.OptParse.Common
import GHCup.Utils.String.QQ
#if !MIN_VERSION_base(4,13,0)
import Control.Monad.Fail ( MonadFail )
#endif
import Control.Monad.Reader
import Control.Monad.Trans.Resource
import Data.Functor
import Data.Maybe
import Data.Versions hiding ( str )
import Haskus.Utils.Variant.Excepts
import Options.Applicative hiding ( style )
import Prelude hiding ( appendFile )
import System.Exit
import Text.PrettyPrint.HughesPJClass ( prettyShow )
import qualified Data.Text as T
import Control.Exception.Safe (MonadMask)
----------------
--[ Commands ]--
----------------
data RmCommand = RmGHC RmOptions
| RmCabal Version
| RmHLS Version
| RmStack Version
---------------
--[ Options ]--
---------------
data RmOptions = RmOptions
{ ghcVer :: GHCTargetVersion
}
---------------
--[ Parsers ]--
---------------
rmParser :: Parser (Either RmCommand RmOptions)
rmParser =
(Left <$> subparser
( command
"ghc"
(RmGHC <$> info (rmOpts (Just GHC) <**> helper) (progDesc "Remove GHC version"))
<> command
"cabal"
( RmCabal
<$> info (versionParser' (Just ListInstalled) (Just Cabal) <**> helper)
(progDesc "Remove Cabal version")
)
<> command
"hls"
( RmHLS
<$> info (versionParser' (Just ListInstalled) (Just HLS) <**> helper)
(progDesc "Remove haskell-language-server version")
)
<> command
"stack"
( RmStack
<$> info (versionParser' (Just ListInstalled) (Just Stack) <**> helper)
(progDesc "Remove stack version")
)
)
)
<|> (Right <$> rmOpts Nothing)
rmOpts :: Maybe Tool -> Parser RmOptions
rmOpts tool = RmOptions <$> versionArgument (Just ListInstalled) tool
--------------
--[ Footer ]--
--------------
rmFooter :: String
rmFooter = [s|Discussion:
Remove the given GHC or cabal version. When no command is given,
defaults to removing GHC with the specified version.
It is recommended to always specify a subcommand (ghc/cabal/hls/stack).|]
---------------------------
--[ Effect interpreters ]--
---------------------------
type RmEffects = '[ NotInstalled ]
runRm :: (ReaderT env m (VEither RmEffects a) -> m (VEither RmEffects a))
-> Excepts RmEffects (ReaderT env m) a
-> m (VEither RmEffects a)
runRm runAppState =
runAppState
. runE
@RmEffects
------------------
--[ Entrypoint ]--
------------------
rm :: ( Monad m
, MonadMask m
, MonadUnliftIO m
, MonadFail m
)
=> Either RmCommand RmOptions
-> (ReaderT AppState m (VEither RmEffects (Maybe VersionInfo))
-> m (VEither RmEffects (Maybe VersionInfo)))
-> (ReaderT LeanAppState m () -> m ())
-> m ExitCode
rm rmCommand runAppState runLogger = case rmCommand of
(Right rmopts) -> do
runLogger (logWarn "This is an old-style command for removing GHC. Use 'ghcup rm ghc' instead.")
rmGHC' rmopts
(Left (RmGHC rmopts)) -> rmGHC' rmopts
(Left (RmCabal rmopts)) -> rmCabal' rmopts
(Left (RmHLS rmopts)) -> rmHLS' rmopts
(Left (RmStack rmopts)) -> rmStack' rmopts
where
rmGHC' RmOptions{..} =
runRm runAppState (do
liftE $
rmGHCVer ghcVer
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
pure (getVersionInfo (_tvVersion ghcVer) GHC dls)
)
>>= \case
VRight vi -> do
forM_ (_viPostRemove =<< vi) $ \msg ->
runLogger $ logInfo msg
pure ExitSuccess
VLeft e -> do
runLogger $ logError $ T.pack $ prettyShow e
pure $ ExitFailure 7
rmCabal' tv =
runRm runAppState (do
liftE $
rmCabalVer tv
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
pure (getVersionInfo tv Cabal dls)
)
>>= \case
VRight vi -> do
forM_ (_viPostRemove =<< vi) $ \msg ->
runLogger $ logInfo msg
pure ExitSuccess
VLeft e -> do
runLogger $ logError $ T.pack $ prettyShow e
pure $ ExitFailure 15
rmHLS' tv =
runRm runAppState (do
liftE $
rmHLSVer tv
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
pure (getVersionInfo tv HLS dls)
)
>>= \case
VRight vi -> do
forM_ (_viPostRemove =<< vi) $ \msg ->
runLogger $ logInfo msg
pure ExitSuccess
VLeft e -> do
runLogger $ logError $ T.pack $ prettyShow e
pure $ ExitFailure 15
rmStack' tv =
runRm runAppState (do
liftE $
rmStackVer tv
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
pure (getVersionInfo tv Stack dls)
)
>>= \case
VRight vi -> do
forM_ (_viPostRemove =<< vi) $ \msg ->
runLogger $ logInfo msg
pure ExitSuccess
VLeft e -> do
runLogger $ logError $ T.pack $ prettyShow e
pure $ ExitFailure 15

View File

@@ -0,0 +1,349 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE RankNTypes #-}
module GHCup.OptParse.Set where
import GHCup.OptParse.Common
import GHCup
import GHCup.Errors
import GHCup.Types
import GHCup.Utils.Logger
import GHCup.Utils.String.QQ
#if !MIN_VERSION_base(4,13,0)
import Control.Monad.Fail ( MonadFail )
#endif
import Control.Monad.Reader
import Control.Monad.Trans.Resource
import Data.Either
import Data.Functor
import Data.Maybe
import Data.Versions hiding ( str )
import GHC.Unicode
import Haskus.Utils.Variant.Excepts
import Options.Applicative hiding ( style )
import Options.Applicative.Help.Pretty ( text )
import Prelude hiding ( appendFile )
import System.Exit
import Text.PrettyPrint.HughesPJClass ( prettyShow )
import qualified Data.Text as T
import Data.Bifunctor (second)
import Control.Exception.Safe (MonadMask)
import GHCup.Types.Optics
----------------
--[ Commands ]--
----------------
data SetCommand = SetGHC SetOptions
| SetCabal SetOptions
| SetHLS SetOptions
| SetStack SetOptions
---------------
--[ Options ]--
---------------
data SetOptions = SetOptions
{ sToolVer :: SetToolVersion
}
---------------
--[ Parsers ]--
---------------
setParser :: Parser (Either SetCommand SetOptions)
setParser =
(Left <$> subparser
( command
"ghc"
( SetGHC
<$> info
(setOpts (Just GHC) <**> helper)
( progDesc "Set GHC version"
<> footerDoc (Just $ text setGHCFooter)
)
)
<> command
"cabal"
( SetCabal
<$> info
(setOpts (Just Cabal) <**> helper)
( progDesc "Set Cabal version"
<> footerDoc (Just $ text setCabalFooter)
)
)
<> command
"hls"
( SetHLS
<$> info
(setOpts (Just HLS) <**> helper)
( progDesc "Set haskell-language-server version"
<> footerDoc (Just $ text setHLSFooter)
)
)
<> command
"stack"
( SetStack
<$> info
(setOpts (Just Stack) <**> helper)
( progDesc "Set stack version"
<> footerDoc (Just $ text setStackFooter)
)
)
)
)
<|> (Right <$> setOpts Nothing)
where
setGHCFooter :: String
setGHCFooter = [s|Discussion:
Sets the the current GHC version by creating non-versioned
symlinks for all ghc binaries of the specified version in
"~/.ghcup/bin/<binary>".|]
setCabalFooter :: String
setCabalFooter = [s|Discussion:
Sets the the current Cabal version.|]
setStackFooter :: String
setStackFooter = [s|Discussion:
Sets the the current Stack version.|]
setHLSFooter :: String
setHLSFooter = [s|Discussion:
Sets the the current haskell-language-server version.|]
setOpts :: Maybe Tool -> Parser SetOptions
setOpts tool = SetOptions <$>
(fromMaybe SetRecommended <$>
optional (setVersionArgument (Just ListInstalled) tool))
setVersionArgument :: Maybe ListCriteria -> Maybe Tool -> Parser SetToolVersion
setVersionArgument criteria tool =
argument (eitherReader setEither)
(metavar "VERSION|TAG|next"
<> completer (tagCompleter (fromMaybe GHC tool) ["next"])
<> foldMap (completer . versionCompleter criteria) tool)
where
setEither s' =
parseSet s'
<|> second SetToolTag (tagEither s')
<|> second SetToolVersion (tVersionEither s')
parseSet s' = case fmap toLower s' of
"next" -> Right SetNext
other -> Left $ "Unknown tag/version " <> other
--------------
--[ Footer ]--
--------------
setFooter :: String
setFooter = [s|Discussion:
Sets the currently active GHC or cabal version. When no command is given,
defaults to setting GHC with the specified version/tag (if no tag
is given, sets GHC to 'recommended' version).
It is recommended to always specify a subcommand (ghc/cabal/hls/stack).|]
---------------------------
--[ Effect interpreters ]--
---------------------------
type SetGHCEffects = '[ FileDoesNotExistError
, NotInstalled
, TagNotFound
, NextVerNotFound
, NoToolVersionSet]
runSetGHC :: (ReaderT env m (VEither SetGHCEffects a) -> m (VEither SetGHCEffects a))
-> Excepts SetGHCEffects (ReaderT env m) a
-> m (VEither SetGHCEffects a)
runSetGHC runAppState =
runAppState
. runE
@SetGHCEffects
type SetCabalEffects = '[ NotInstalled
, TagNotFound
, NextVerNotFound
, NoToolVersionSet]
runSetCabal :: (ReaderT env m (VEither SetCabalEffects a) -> m (VEither SetCabalEffects a))
-> Excepts SetCabalEffects (ReaderT env m) a
-> m (VEither SetCabalEffects a)
runSetCabal runAppState =
runAppState
. runE
@SetCabalEffects
type SetHLSEffects = '[ NotInstalled
, TagNotFound
, NextVerNotFound
, NoToolVersionSet]
runSetHLS :: (ReaderT env m (VEither SetHLSEffects a) -> m (VEither SetHLSEffects a))
-> Excepts SetHLSEffects (ReaderT env m) a
-> m (VEither SetHLSEffects a)
runSetHLS runAppState =
runAppState
. runE
@SetHLSEffects
type SetStackEffects = '[ NotInstalled
, TagNotFound
, NextVerNotFound
, NoToolVersionSet]
runSetStack :: (ReaderT env m (VEither SetStackEffects a) -> m (VEither SetStackEffects a))
-> Excepts SetStackEffects (ReaderT env m) a
-> m (VEither SetStackEffects a)
runSetStack runAppState =
runAppState
. runE
@SetStackEffects
-------------------
--[ Entrypoints ]--
-------------------
set :: forall m env.
( Monad m
, MonadMask m
, MonadUnliftIO m
, MonadFail m
, HasDirs env
, HasLog env
)
=> Either SetCommand SetOptions
-> (forall eff . ReaderT AppState m (VEither eff GHCTargetVersion)
-> m (VEither eff GHCTargetVersion))
-> (forall eff. ReaderT env m (VEither eff GHCTargetVersion)
-> m (VEither eff GHCTargetVersion))
-> (ReaderT LeanAppState m () -> m ())
-> m ExitCode
set setCommand runAppState runLeanAppState runLogger = case setCommand of
(Right sopts) -> do
runLogger (logWarn "This is an old-style command for setting GHC. Use 'ghcup set ghc' instead.")
setGHC' sopts
(Left (SetGHC sopts)) -> setGHC' sopts
(Left (SetCabal sopts)) -> setCabal' sopts
(Left (SetHLS sopts)) -> setHLS' sopts
(Left (SetStack sopts)) -> setStack' sopts
where
setGHC' :: SetOptions
-> m ExitCode
setGHC' SetOptions{ sToolVer } =
case sToolVer of
(SetToolVersion v) -> runSetGHC runLeanAppState (liftE $ setGHC v SetGHCOnly >> pure v)
_ -> runSetGHC runAppState (do
v <- liftE $ fst <$> fromVersion' sToolVer GHC
liftE $ setGHC v SetGHCOnly
)
>>= \case
VRight GHCTargetVersion{..} -> do
runLogger
$ logInfo $
"GHC " <> prettyVer _tvVersion <> " successfully set as default version" <> maybe "" (" for cross target " <>) _tvTarget
pure ExitSuccess
VLeft e -> do
runLogger $ logError $ T.pack $ prettyShow e
pure $ ExitFailure 5
setCabal' :: SetOptions
-> m ExitCode
setCabal' SetOptions{ sToolVer } =
case sToolVer of
(SetToolVersion v) -> runSetCabal runLeanAppState (liftE $ setCabal (_tvVersion v) >> pure v)
_ -> runSetCabal runAppState (do
v <- liftE $ fst <$> fromVersion' sToolVer Cabal
liftE $ setCabal (_tvVersion v)
pure v
)
>>= \case
VRight GHCTargetVersion{..} -> do
runLogger
$ logInfo $
"Cabal " <> prettyVer _tvVersion <> " successfully set as default version"
pure ExitSuccess
VLeft e -> do
runLogger $ logError $ T.pack $ prettyShow e
pure $ ExitFailure 14
setHLS' :: SetOptions
-> m ExitCode
setHLS' SetOptions{ sToolVer } =
case sToolVer of
(SetToolVersion v) -> runSetHLS runLeanAppState (liftE $ setHLS (_tvVersion v) >> pure v)
_ -> runSetHLS runAppState (do
v <- liftE $ fst <$> fromVersion' sToolVer HLS
liftE $ setHLS (_tvVersion v)
pure v
)
>>= \case
VRight GHCTargetVersion{..} -> do
runLogger
$ logInfo $
"HLS " <> prettyVer _tvVersion <> " successfully set as default version"
pure ExitSuccess
VLeft e -> do
runLogger $ logError $ T.pack $ prettyShow e
pure $ ExitFailure 14
setStack' :: SetOptions
-> m ExitCode
setStack' SetOptions{ sToolVer } =
case sToolVer of
(SetToolVersion v) -> runSetStack runLeanAppState (liftE $ setStack (_tvVersion v) >> pure v)
_ -> runSetStack runAppState (do
v <- liftE $ fst <$> fromVersion' sToolVer Stack
liftE $ setStack (_tvVersion v)
pure v
)
>>= \case
VRight GHCTargetVersion{..} -> do
runLogger
$ logInfo $
"Stack " <> prettyVer _tvVersion <> " successfully set as default version"
pure ExitSuccess
VLeft e -> do
runLogger $ logError $ T.pack $ prettyShow e
pure $ ExitFailure 14

View File

@@ -0,0 +1,82 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE RankNTypes #-}
module GHCup.OptParse.ToolRequirements where
import GHCup.Errors
import GHCup.Types
import GHCup.Utils.Logger
#if !MIN_VERSION_base(4,13,0)
import Control.Monad.Fail ( MonadFail )
#endif
import Control.Monad.Reader
import Control.Monad.Trans.Resource
import Haskus.Utils.Variant.Excepts
import Options.Applicative hiding ( style )
import Prelude hiding ( appendFile )
import System.Exit
import Text.PrettyPrint.HughesPJClass ( prettyShow )
import qualified Data.Text as T
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.Requirements
import System.IO
---------------------------
--[ Effect interpreters ]--
---------------------------
type ToolRequirementsEffects = '[ NoCompatiblePlatform , DistroNotFound , NoToolRequirements ]
runToolRequirements :: (ReaderT env m (VEither ToolRequirementsEffects a) -> m (VEither ToolRequirementsEffects a))
-> Excepts ToolRequirementsEffects (ReaderT env m) a
-> m (VEither ToolRequirementsEffects a)
runToolRequirements runAppState =
runAppState
. runE
@ToolRequirementsEffects
------------------
--[ Entrypoint ]--
------------------
toolRequirements :: ( Monad m
, MonadMask m
, MonadUnliftIO m
, MonadFail m
, Alternative m
)
=> (ReaderT AppState m (VEither ToolRequirementsEffects ()) -> m (VEither ToolRequirementsEffects ()))
-> (ReaderT LeanAppState m () -> m ())
-> m ExitCode
toolRequirements runAppState runLogger = runToolRequirements runAppState (do
GHCupInfo { .. } <- lift getGHCupInfo
platform' <- liftE getPlatform
req <- getCommonRequirements platform' _toolRequirements ?? NoToolRequirements
liftIO $ T.hPutStr stdout (prettyRequirements req)
)
>>= \case
VRight _ -> pure ExitSuccess
VLeft e -> do
runLogger $ logError $ T.pack $ prettyShow e
pure $ ExitFailure 12

View File

@@ -0,0 +1,205 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE RankNTypes #-}
module GHCup.OptParse.UnSet where
import GHCup
import GHCup.Errors
import GHCup.Types
import GHCup.Utils.Logger
import GHCup.Utils.String.QQ
#if !MIN_VERSION_base(4,13,0)
import Control.Monad.Fail ( MonadFail )
#endif
import Control.Monad.Reader
import Control.Monad.Trans.Resource
import Data.Functor
import Data.Maybe
import Haskus.Utils.Variant.Excepts
import Options.Applicative hiding ( style )
import Options.Applicative.Help.Pretty ( text )
import Prelude hiding ( appendFile )
import System.Exit
import Text.PrettyPrint.HughesPJClass ( prettyShow )
import qualified Data.Text as T
import Control.Exception.Safe (MonadMask)
import GHCup.Types.Optics
----------------
--[ Commands ]--
----------------
data UnsetCommand = UnsetGHC UnsetOptions
| UnsetCabal UnsetOptions
| UnsetHLS UnsetOptions
| UnsetStack UnsetOptions
---------------
--[ Options ]--
---------------
data UnsetOptions = UnsetOptions
{ sToolVer :: Maybe T.Text -- target platform triple
}
---------------
--[ Parsers ]--
---------------
unsetParser :: Parser UnsetCommand
unsetParser =
subparser
( command
"ghc"
( UnsetGHC
<$> info
(unsetOpts <**> helper)
( progDesc "Unset GHC version"
<> footerDoc (Just $ text unsetGHCFooter)
)
)
<> command
"cabal"
( UnsetCabal
<$> info
(unsetOpts <**> helper)
( progDesc "Unset Cabal version"
<> footerDoc (Just $ text unsetCabalFooter)
)
)
<> command
"hls"
( UnsetHLS
<$> info
(unsetOpts <**> helper)
( progDesc "Unset haskell-language-server version"
<> footerDoc (Just $ text unsetHLSFooter)
)
)
<> command
"stack"
( UnsetStack
<$> info
(unsetOpts <**> helper)
( progDesc "Unset stack version"
<> footerDoc (Just $ text unsetStackFooter)
)
)
)
where
unsetGHCFooter :: String
unsetGHCFooter = [s|Discussion:
Unsets the the current GHC version. That means there won't
be a ~/.ghcup/bin/ghc anymore.|]
unsetCabalFooter :: String
unsetCabalFooter = [s|Discussion:
Unsets the the current Cabal version.|]
unsetStackFooter :: String
unsetStackFooter = [s|Discussion:
Unsets the the current Stack version.|]
unsetHLSFooter :: String
unsetHLSFooter = [s|Discussion:
Unsets the the current haskell-language-server version.|]
unsetOpts :: Parser UnsetOptions
unsetOpts = UnsetOptions . fmap T.pack <$> optional (argument str (metavar "TRIPLE"))
--------------
--[ Footer ]--
--------------
unsetFooter :: String
unsetFooter = [s|Discussion:
Unsets the currently active GHC or cabal version.|]
---------------------------
--[ Effect interpreters ]--
---------------------------
type UnsetEffects = '[ NotInstalled ]
runUnsetGHC :: (ReaderT env m (VEither UnsetEffects a) -> m (VEither UnsetEffects a))
-> Excepts UnsetEffects (ReaderT env m) a
-> m (VEither UnsetEffects a)
runUnsetGHC runLeanAppState =
runLeanAppState
. runE
@UnsetEffects
------------------
--[ Entrypoint ]--
------------------
unset :: ( Monad m
, MonadMask m
, MonadUnliftIO m
, MonadFail m
, HasDirs env
, HasLog env
)
=> UnsetCommand
-> (ReaderT env m (VEither UnsetEffects ())
-> m (VEither UnsetEffects ()))
-> (ReaderT LeanAppState m () -> m ())
-> m ExitCode
unset unsetCommand runLeanAppState runLogger = case unsetCommand of
(UnsetGHC (UnsetOptions triple)) -> runUnsetGHC runLeanAppState (unsetGHC triple)
>>= \case
VRight _ -> do
runLogger $ logInfo "GHC successfully unset"
pure ExitSuccess
VLeft e -> do
runLogger $ logError $ T.pack $ prettyShow e
pure $ ExitFailure 14
(UnsetCabal (UnsetOptions _)) -> do
void $ runLeanAppState (VRight <$> unsetCabal)
runLogger $ logInfo "Cabal successfully unset"
pure ExitSuccess
(UnsetHLS (UnsetOptions _)) -> do
void $ runLeanAppState (VRight <$> unsetHLS)
runLogger $ logInfo "HLS successfully unset"
pure ExitSuccess
(UnsetStack (UnsetOptions _)) -> do
void $ runLeanAppState (VRight <$> unsetStack)
runLogger $ logInfo "Stack successfully unset"
pure ExitSuccess

View File

@@ -0,0 +1,150 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE RankNTypes #-}
module GHCup.OptParse.Upgrade where
import GHCup
import GHCup.Errors
import GHCup.Types
import GHCup.Utils.Logger
#if !MIN_VERSION_base(4,13,0)
import Control.Monad.Fail ( MonadFail )
#endif
import Control.Monad.Reader
import Control.Monad.Trans.Resource
import Data.Functor
import Data.Maybe
import Haskus.Utils.Variant.Excepts
import Options.Applicative hiding ( style )
import Prelude hiding ( appendFile )
import System.Exit
import Text.PrettyPrint.HughesPJClass ( prettyShow )
import qualified Data.Text as T
import Control.Exception.Safe (MonadMask)
import System.Environment
import GHCup.Utils
import System.FilePath
import GHCup.Types.Optics
import Data.Versions hiding (str)
---------------
--[ Options ]--
---------------
data UpgradeOpts = UpgradeInplace
| UpgradeAt FilePath
| UpgradeGHCupDir
deriving Show
---------------
--[ Parsers ]--
---------------
upgradeOptsP :: Parser UpgradeOpts
upgradeOptsP =
flag'
UpgradeInplace
(short 'i' <> long "inplace" <> help
"Upgrade ghcup in-place (wherever it's at)"
)
<|> ( UpgradeAt
<$> option
str
(short 't' <> long "target" <> metavar "TARGET_DIR" <> help
"Absolute filepath to write ghcup into"
)
)
<|> pure UpgradeGHCupDir
---------------------------
--[ Effect interpreters ]--
---------------------------
type UpgradeEffects = '[ DigestError
, GPGError
, NoDownload
, NoUpdate
, FileDoesNotExistError
, CopyError
, DownloadFailed
]
runUpgrade :: MonadUnliftIO m
=> (ReaderT AppState m (VEither UpgradeEffects a) -> m (VEither UpgradeEffects a))
-> Excepts UpgradeEffects (ResourceT (ReaderT AppState m)) a
-> m (VEither UpgradeEffects a)
runUpgrade runAppState =
runAppState
. runResourceT
. runE
@UpgradeEffects
------------------
--[ Entrypoint ]--
------------------
upgrade :: ( Monad m
, MonadMask m
, MonadUnliftIO m
, MonadFail m
)
=> UpgradeOpts
-> Bool
-> (forall a. ReaderT AppState m (VEither UpgradeEffects a) -> m (VEither UpgradeEffects a))
-> (ReaderT LeanAppState m () -> m ())
-> m ExitCode
upgrade uOpts force' runAppState runLogger = do
VRight Dirs{ .. } <- runAppState (VRight <$> getDirs)
target <- case uOpts of
UpgradeInplace -> Just <$> liftIO getExecutablePath
(UpgradeAt p) -> pure $ Just p
UpgradeGHCupDir -> pure (Just (binDir </> "ghcup" <> exeExt))
runUpgrade runAppState (do
v' <- liftE $ upgradeGHCup target force'
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
pure (v', dls)
) >>= \case
VRight (v', dls) -> do
let pretty_v = prettyVer v'
let vi = fromJust $ snd <$> getLatest dls GHCup
runLogger $ logInfo $
"Successfully upgraded GHCup to version " <> pretty_v
forM_ (_viPostInstall vi) $ \msg ->
runLogger $ logInfo msg
pure ExitSuccess
VLeft (V NoUpdate) -> do
runLogger $ logWarn "No GHCup update available"
pure ExitSuccess
VLeft e -> do
runLogger $ logError $ T.pack $ prettyShow e
pure $ ExitFailure 11

View File

@@ -0,0 +1,319 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE RankNTypes #-}
module GHCup.OptParse.Whereis where
import GHCup
import GHCup.Errors
import GHCup.OptParse.Common
import GHCup.Types
import GHCup.Utils.Logger
import GHCup.Utils.String.QQ
#if !MIN_VERSION_base(4,13,0)
import Control.Monad.Fail ( MonadFail )
#endif
import Control.Monad.Reader
import Control.Monad.Trans.Resource
import Data.Functor
import Data.Maybe
import Haskus.Utils.Variant.Excepts
import Options.Applicative hiding ( style )
import Options.Applicative.Help.Pretty ( text )
import Prelude hiding ( appendFile )
import System.Exit
import Text.PrettyPrint.HughesPJClass ( prettyShow )
import qualified Data.Text as T
import Control.Exception.Safe (MonadMask)
import System.FilePath (takeDirectory)
import GHCup.Types.Optics
----------------
--[ Commands ]--
----------------
data WhereisCommand = WhereisTool Tool (Maybe ToolVersion)
| WhereisBaseDir
| WhereisBinDir
| WhereisCacheDir
| WhereisLogsDir
| WhereisConfDir
---------------
--[ Options ]--
---------------
data WhereisOptions = WhereisOptions {
directory :: Bool
}
---------------
--[ Parsers ]--
---------------
whereisP :: Parser WhereisCommand
whereisP = subparser
(commandGroup "Tools locations:" <>
command
"ghc"
(WhereisTool GHC <$> info
( optional (toolVersionArgument Nothing (Just GHC)) <**> helper )
( progDesc "Get GHC location"
<> footerDoc (Just $ text whereisGHCFooter ))
)
<>
command
"cabal"
(WhereisTool Cabal <$> info
( optional (toolVersionArgument Nothing (Just Cabal)) <**> helper )
( progDesc "Get cabal location"
<> footerDoc (Just $ text whereisCabalFooter ))
)
<>
command
"hls"
(WhereisTool HLS <$> info
( optional (toolVersionArgument Nothing (Just HLS)) <**> helper )
( progDesc "Get HLS location"
<> footerDoc (Just $ text whereisHLSFooter ))
)
<>
command
"stack"
(WhereisTool Stack <$> info
( optional (toolVersionArgument Nothing (Just Stack)) <**> helper )
( progDesc "Get stack location"
<> footerDoc (Just $ text whereisStackFooter ))
)
<>
command
"ghcup"
(WhereisTool GHCup <$> info ( pure Nothing <**> helper ) ( progDesc "Get ghcup location" ))
) <|> subparser ( commandGroup "Directory locations:"
<>
command
"basedir"
(info (pure WhereisBaseDir <**> helper)
( progDesc "Get ghcup base directory location" )
)
<>
command
"bindir"
(info (pure WhereisBinDir <**> helper)
( progDesc "Get ghcup binary directory location" )
)
<>
command
"cachedir"
(info (pure WhereisCacheDir <**> helper)
( progDesc "Get ghcup cache directory location" )
)
<>
command
"logsdir"
(info (pure WhereisLogsDir <**> helper)
( progDesc "Get ghcup logs directory location" )
)
<>
command
"confdir"
(info (pure WhereisConfDir <**> helper)
( progDesc "Get ghcup config directory location" )
)
)
where
whereisGHCFooter = [s|Discussion:
Finds the location of a GHC executable, which usually resides in
a self-contained "~/.ghcup/ghc/<ghcver>" directory.
Examples:
# outputs ~/.ghcup/ghc/8.10.5/bin/ghc.exe
ghcup whereis ghc 8.10.5
# outputs ~/.ghcup/ghc/8.10.5/bin/
ghcup whereis --directory ghc 8.10.5 |]
whereisCabalFooter = [s|Discussion:
Finds the location of a Cabal executable, which usually resides in
"~/.ghcup/bin/".
Examples:
# outputs ~/.ghcup/bin/cabal-3.4.0.0
ghcup whereis cabal 3.4.0.0
# outputs ~/.ghcup/bin
ghcup whereis --directory cabal 3.4.0.0|]
whereisHLSFooter = [s|Discussion:
Finds the location of a HLS executable, which usually resides in
"~/.ghcup/bin/".
Examples:
# outputs ~/.ghcup/bin/haskell-language-server-wrapper-1.2.0
ghcup whereis hls 1.2.0
# outputs ~/.ghcup/bin/
ghcup whereis --directory hls 1.2.0|]
whereisStackFooter = [s|Discussion:
Finds the location of a stack executable, which usually resides in
"~/.ghcup/bin/".
Examples:
# outputs ~/.ghcup/bin/stack-2.7.1
ghcup whereis stack 2.7.1
# outputs ~/.ghcup/bin/
ghcup whereis --directory stack 2.7.1|]
--------------
--[ Footer ]--
--------------
whereisFooter :: String
whereisFooter = [s|Discussion:
Finds the location of a tool. For GHC, this is the ghc binary, that
usually resides in a self-contained "~/.ghcup/ghc/<ghcver>" directory.
For cabal/stack/hls this the binary usually at "~/.ghcup/bin/<tool>-<ver>".
Examples:
# outputs ~/.ghcup/ghc/8.10.5/bin/ghc.exe
ghcup whereis ghc 8.10.5
# outputs ~/.ghcup/ghc/8.10.5/bin/
ghcup whereis --directory ghc 8.10.5
# outputs ~/.ghcup/bin/cabal-3.4.0.0
ghcup whereis cabal 3.4.0.0
# outputs ~/.ghcup/bin/
ghcup whereis --directory cabal 3.4.0.0|]
---------------------------
--[ Effect interpreters ]--
---------------------------
type WhereisEffects = '[ NotInstalled
, NoToolVersionSet
, NextVerNotFound
, TagNotFound
]
runLeanWhereIs :: (MonadUnliftIO m, MonadIO m)
=> LeanAppState
-> Excepts WhereisEffects (ReaderT LeanAppState m) a
-> m (VEither WhereisEffects a)
runLeanWhereIs leanAppstate =
-- Don't use runLeanAppState here, which is disabled on windows.
-- This is the only command on all platforms that doesn't need full appstate.
flip runReaderT leanAppstate
. runE
@WhereisEffects
runWhereIs :: (MonadUnliftIO m, MonadIO m)
=> (ReaderT AppState m (VEither WhereisEffects a) -> m (VEither WhereisEffects a))
-> Excepts WhereisEffects (ReaderT AppState m) a
-> m (VEither WhereisEffects a)
runWhereIs runAppState =
runAppState
. runE
@WhereisEffects
------------------
--[ Entrypoint ]--
------------------
whereis :: ( Monad m
, MonadMask m
, MonadUnliftIO m
, MonadFail m
)
=> WhereisCommand
-> WhereisOptions
-> (forall a. ReaderT AppState m (VEither WhereisEffects a) -> m (VEither WhereisEffects a))
-> LeanAppState
-> (ReaderT LeanAppState m () -> m ())
-> m ExitCode
whereis whereisCommand whereisOptions runAppState leanAppstate runLogger = do
Dirs{ .. } <- runReaderT getDirs leanAppstate
case (whereisCommand, whereisOptions) of
(WhereisTool tool (Just (ToolVersion v)), WhereisOptions{..}) ->
runLeanWhereIs leanAppstate (do
loc <- liftE $ whereIsTool tool v
if directory
then pure $ takeDirectory loc
else pure loc
)
>>= \case
VRight r -> do
liftIO $ putStr r
pure ExitSuccess
VLeft e -> do
runLogger $ logError $ T.pack $ prettyShow e
pure $ ExitFailure 30
(WhereisTool tool whereVer, WhereisOptions{..}) -> do
runWhereIs runAppState (do
(v, _) <- liftE $ fromVersion whereVer tool
loc <- liftE $ whereIsTool tool v
if directory
then pure $ takeDirectory loc
else pure loc
)
>>= \case
VRight r -> do
liftIO $ putStr r
pure ExitSuccess
VLeft e -> do
runLogger $ logError $ T.pack $ prettyShow e
pure $ ExitFailure 30
(WhereisBaseDir, _) -> do
liftIO $ putStr baseDir
pure ExitSuccess
(WhereisBinDir, _) -> do
liftIO $ putStr binDir
pure ExitSuccess
(WhereisCacheDir, _) -> do
liftIO $ putStr cacheDir
pure ExitSuccess
(WhereisLogsDir, _) -> do
liftIO $ putStr logsDir
pure ExitSuccess
(WhereisConfDir, _) -> do
liftIO $ putStr confDir
pure ExitSuccess

File diff suppressed because it is too large Load Diff

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,8 +9,8 @@ package ghcup
flags: +tui
constraints: http-io-streams -brotli,
any.Cabal ==3.4.0.0 || ==3.6.2.0
any.Cabal ==3.6.2.0,
any.aeson >= 2.0.1.0
package libarchive
flags: -system-libarchive
@@ -21,4 +21,7 @@ package aeson-pretty
package cabal-plan
flags: -exe
package aeson
flags: +ordered-keymap
allow-newer: base, ghc-prim, template-haskell, language-c

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:

File diff suppressed because it is too large Load Diff

File diff suppressed because it is too large Load Diff

File diff suppressed because it is too large Load Diff

File diff suppressed because it is too large Load Diff

File diff suppressed because it is too large Load Diff

File diff suppressed because it is too large Load Diff

File diff suppressed because it is too large Load Diff

View File

@@ -66,18 +66,14 @@ Some light suggestions:
### Adding a new GHC version
1. open the latest `data/metadata/ghcup-<yaml-ver>.yaml`
2. find the latest ghc version (in yaml tree e.g. `ghcupDownloads -> GHC -> 8.10.7`)
3. copy-paste it
4. adjust the version, tags, changelog, source url
5. adjust the various bindist urls (make sure to also change the yaml anchors)
6. run `cabal run exe:ghcup-gen -- check -f data/metadata/ghcup-<yaml-ver>.yaml`
7. run `cabal run exe:ghcup-gen -- check-tarballs -f data/metadata/ghcup-<yaml-ver>.yaml -u 'ghc-8\.10\.8'`
Head over to: [https://github.com/haskell/ghcup-metadata#adding-a-new-ghc-version](https://github.com/haskell/ghcup-metadata#adding-a-new-ghc-version)
### Adding a new CLI command
An example illustration on how to deal with [optparse-applicative](https://hackage.haskell.org/package/optparse-applicative) can be seen here: [https://gitlab.haskell.org/haskell/ghcup-hs/-/commit/c19dd5ee8b2edbaf0336af143f1c75b6f4843e26](https://gitlab.haskell.org/haskell/ghcup-hs/-/commit/c19dd5ee8b2edbaf0336af143f1c75b6f4843e26)
Every subcommand now lives in its own module under [GHCup.OptParse.MyCommand](https://gitlab.haskell.org/haskell/ghcup-hs/-/tree/master/app/ghcup/GHCup/OptParse).
## Major refactors
1. First major refactor included adding cross support. This added
@@ -89,6 +85,7 @@ An example illustration on how to deal with [optparse-applicative](https://hacka
The major changes here were switching `hpath` library out for `filepath`/`directory` (sadly) and
introducing a non-unix way of handling processes via the `process` library. It also introduced considerable
amounts of CPP wrt file handling, installation etc.
3. This refactor split up the huge `Main.hs` and put every subcommand in its own module: [#212](https://gitlab.haskell.org/haskell/ghcup-hs/-/merge_requests/212)
# Releasing
@@ -98,21 +95,19 @@ An example illustration on how to deal with [optparse-applicative](https://hacka
3. Add ChangeLog entry
4. Add/fix downloads in `ghcup-<ver>.yaml` (under `data/metadata`), then verify with `ghcup-gen check -f data/metadata/ghcup-<ver>.yaml` and possibly (example only) `ghcup-gen check-tarballs -f data/metadata/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 `data/metadata/ghcup-<ver>.yaml` (and a detached GPG sig of it) to `webhost.haskell.org/ghcup/data/`.
8. Upload `bootstrap-haskell` and `bootstrap-haskell.ps1` to `webhost.haskell.org/ghcup/sh/`
9. Update `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

@@ -4,363 +4,638 @@
<!-- Generated by graphviz version 2.44.0 (0)
-->
<!-- Title: G Pages: 1 -->
<svg width="719pt" height="648pt"
viewBox="0.00 0.00 719.28 648.00" xmlns="http://www.w3.org/2000/svg" xmlns:xlink="http://www.w3.org/1999/xlink">
<g id="graph0" class="graph" transform="scale(0.81 0.81) rotate(0) translate(4 794.2)">
<svg width="720pt" height="648pt"
viewBox="0.00 0.00 719.60 648.00" xmlns="http://www.w3.org/2000/svg" xmlns:xlink="http://www.w3.org/1999/xlink">
<g id="graph0" class="graph" transform="scale(0.45 0.45) rotate(0) translate(4 1421.5)">
<title>G</title>
<polygon fill="white" stroke="transparent" points="-4,4 -4,-794.2 882,-794.2 882,4 -4,4"/>
<polygon fill="white" stroke="transparent" points="-4,4 -4,-1421.5 1579,-1421.5 1579,4 -4,4"/>
<g id="clust1" class="cluster">
<title>cluster_0</title>
<polygon fill="#000000" fill-opacity="0.058824" stroke="#000000" stroke-opacity="0.058824" points="8,-8.95 8,-660.37 870,-660.37 870,-8.95 8,-8.95"/>
<text text-anchor="middle" x="439" y="-645.17" font-family="Times-Roman" font-size="14.00">GHCup</text>
<polygon fill="#000000" fill-opacity="0.058824" stroke="#000000" stroke-opacity="0.058824" points="8,-12.99 8,-1346.06 1567,-1346.06 1567,-12.99 8,-12.99"/>
<text text-anchor="middle" x="787.5" y="-1330.86" font-family="Times-Roman" font-size="14.00">GHCup</text>
</g>
<g id="clust2" class="cluster">
<title>cluster_1</title>
<polygon fill="#000000" fill-opacity="0.058824" stroke="#000000" stroke-opacity="0.058824" points="190,-364.88 190,-541.72 450,-541.72 450,-364.88 190,-364.88"/>
<text text-anchor="middle" x="320" y="-526.52" font-family="Times-Roman" font-size="14.00">Download</text>
<polygon fill="#000000" fill-opacity="0.058824" stroke="#000000" stroke-opacity="0.058824" points="1102,-529.33 1102,-823.22 1362,-823.22 1362,-529.33 1102,-529.33"/>
<text text-anchor="middle" x="1232" y="-808.02" font-family="Times-Roman" font-size="14.00">Download</text>
</g>
<g id="clust3" class="cluster">
<title>cluster_2</title>
<polygon fill="#000000" fill-opacity="0.058824" stroke="#000000" stroke-opacity="0.058824" points="271,-191.39 271,-355.93 452,-355.93 452,-191.39 271,-191.39"/>
<text text-anchor="middle" x="361.5" y="-340.73" font-family="Times-Roman" font-size="14.00">Types</text>
<polygon fill="#000000" fill-opacity="0.058824" stroke="#000000" stroke-opacity="0.058824" points="16,-940.13 16,-1295.72 1559,-1295.72 1559,-940.13 16,-940.13"/>
<text text-anchor="middle" x="787.5" y="-1280.52" font-family="Times-Roman" font-size="14.00">OptParse</text>
</g>
<g id="clust4" class="cluster">
<title>cluster_3</title>
<polygon fill="#000000" fill-opacity="0.058824" stroke="#000000" stroke-opacity="0.058824" points="566,-17.91 566,-576.42 862,-576.42 862,-17.91 566,-17.91"/>
<text text-anchor="middle" x="714" y="-561.22" font-family="Times-Roman" font-size="14.00">Utils</text>
<polygon fill="#000000" fill-opacity="0.058824" stroke="#000000" stroke-opacity="0.058824" points="1196,-277.65 1196,-516.34 1377,-516.34 1377,-277.65 1196,-277.65"/>
<text text-anchor="middle" x="1286.5" y="-501.14" font-family="Times-Roman" font-size="14.00">Types</text>
</g>
<g id="clust5" class="cluster">
<title>cluster_4</title>
<polygon fill="#000000" fill-opacity="0.058824" stroke="#000000" stroke-opacity="0.058824" points="640,-271.98 640,-448.82 758,-448.82 758,-271.98 640,-271.98"/>
<text text-anchor="middle" x="699" y="-433.62" font-family="Times-Roman" font-size="14.00">File</text>
<polygon fill="#000000" fill-opacity="0.058824" stroke="#000000" stroke-opacity="0.058824" points="586,-25.98 586,-701.44 1082,-701.44 1082,-25.98 586,-25.98"/>
<text text-anchor="middle" x="834" y="-686.24" font-family="Times-Roman" font-size="14.00">Utils</text>
</g>
<g id="clust6" class="cluster">
<title>cluster_5</title>
<polygon fill="#000000" fill-opacity="0.058824" stroke="#000000" stroke-opacity="0.058824" points="583,-26.86 583,-110.81 653,-110.81 653,-26.86 583,-26.86"/>
<text text-anchor="middle" x="618" y="-95.61" font-family="Times-Roman" font-size="14.00">String</text>
<polygon fill="#000000" fill-opacity="0.058824" stroke="#000000" stroke-opacity="0.058824" points="744,-394.56 744,-651.11 862,-651.11 862,-394.56 744,-394.56"/>
<text text-anchor="middle" x="803" y="-635.91" font-family="Times-Roman" font-size="14.00">File</text>
</g>
<g id="clust7" class="cluster">
<title>cluster_6</title>
<polygon fill="#000000" fill-opacity="0.058824" stroke="#000000" stroke-opacity="0.058824" points="712,-457.78 712,-541.72 782,-541.72 782,-457.78 712,-457.78"/>
<text text-anchor="middle" x="747" y="-526.52" font-family="Times-Roman" font-size="14.00">Version</text>
<polygon fill="#000000" fill-opacity="0.058824" stroke="#000000" stroke-opacity="0.058824" points="995,-38.97 995,-160.75 1065,-160.75 1065,-38.97 995,-38.97"/>
<text text-anchor="middle" x="1030" y="-145.55" font-family="Times-Roman" font-size="14.00">String</text>
</g>
<g id="clust8" class="cluster">
<title>cluster_7</title>
<polygon fill="#000000" fill-opacity="0.058824" stroke="#000000" stroke-opacity="0.058824" points="594,-529.33 594,-651.11 664,-651.11 664,-529.33 594,-529.33"/>
<text text-anchor="middle" x="629" y="-635.91" font-family="Times-Roman" font-size="14.00">Version</text>
</g>
<!-- u1 -->
<g id="node1" class="node">
<title>u1</title>
<ellipse fill="#ffffbb" stroke="black" stroke-width="2" cx="387" cy="-486.95" rx="55.49" ry="18"/>
<text text-anchor="middle" x="387" y="-483.25" font-family="Times-Roman" font-size="14.00">Download</text>
<ellipse fill="#ffffbb" stroke="black" stroke-width="2" cx="1165" cy="-743.99" rx="55.49" ry="18"/>
<text text-anchor="middle" x="1165" y="-740.29" font-family="Times-Roman" font-size="14.00">Download</text>
</g>
<!-- u12 -->
<g id="node7" class="node">
<g id="node24" class="node">
<title>u12</title>
<ellipse fill="#bbffff" stroke="black" stroke-width="2" cx="688" cy="-393.95" rx="27" ry="18"/>
<text text-anchor="middle" x="688" y="-390.25" font-family="Times-Roman" font-size="14.00">File</text>
<ellipse fill="#ffbbff" stroke="black" stroke-width="2" cx="825" cy="-571.99" rx="27" ry="18"/>
<text text-anchor="middle" x="825" y="-568.29" font-family="Times-Roman" font-size="14.00">File</text>
</g>
<!-- u1&#45;&gt;u12 -->
<g id="edge15" class="edge">
<g id="edge13" class="edge">
<title>u1&#45;&gt;u12</title>
<path fill="none" stroke="black" d="M416.08,-471.48C425.43,-467.42 435.96,-463.44 446,-460.95 491.68,-449.63 616.67,-467.2 657,-442.95 665.62,-437.77 672.27,-429.17 677.16,-420.67"/>
<polygon fill="black" stroke="black" points="680.34,-422.15 681.79,-411.65 674.11,-418.95 680.34,-422.15"/>
<path fill="none" stroke="black" d="M1125,-731.45C1042,-707.49 858.55,-654.33 856,-651.99 841.25,-638.47 833.42,-617.06 829.33,-599.94"/>
<polygon fill="black" stroke="black" points="832.71,-599.01 827.23,-589.94 825.86,-600.45 832.71,-599.01"/>
</g>
<!-- u11 -->
<g id="node15" class="node">
<g id="node32" class="node">
<title>u11</title>
<ellipse fill="#bbffff" stroke="black" stroke-width="0" cx="603" cy="-393.95" rx="28.7" ry="18"/>
<text text-anchor="middle" x="603" y="-390.25" font-family="Times-Roman" font-size="14.00">Dirs</text>
<ellipse fill="#ffbbff" stroke="black" stroke-width="0" cx="1045" cy="-571.99" rx="28.7" ry="18"/>
<text text-anchor="middle" x="1045" y="-568.29" font-family="Times-Roman" font-size="14.00">Dirs</text>
</g>
<!-- u1&#45;&gt;u11 -->
<g id="edge14" class="edge">
<g id="edge12" class="edge">
<title>u1&#45;&gt;u11</title>
<path fill="none" stroke="black" d="M419.14,-472.31C427.86,-468.62 437.29,-464.63 446,-460.95 489.08,-442.77 538.85,-421.87 570.6,-408.54"/>
<polygon fill="black" stroke="black" points="571.98,-411.76 579.85,-404.66 569.27,-405.3 571.98,-411.76"/>
<path fill="none" stroke="black" d="M1152.43,-726.38C1138.8,-708.25 1116.51,-678.31 1098,-651.99 1085.29,-633.92 1071.4,-613.17 1061.02,-597.47"/>
<polygon fill="black" stroke="black" points="1063.78,-595.29 1055.36,-588.87 1057.94,-599.14 1063.78,-595.29"/>
</g>
<!-- u13 -->
<g id="node18" class="node">
<g id="node35" class="node">
<title>u13</title>
<ellipse fill="#ffffbb" stroke="black" stroke-width="0" cx="109" cy="-300.95" rx="44.39" ry="18"/>
<text text-anchor="middle" x="109" y="-297.25" font-family="Times-Roman" font-size="14.00">Version</text>
<ellipse fill="#ffffbb" stroke="black" stroke-width="0" cx="1414" cy="-571.99" rx="44.39" ry="18"/>
<text text-anchor="middle" x="1414" y="-568.29" font-family="Times-Roman" font-size="14.00">Version</text>
</g>
<!-- u1&#45;&gt;u13 -->
<g id="edge13" class="edge">
<g id="edge11" class="edge">
<title>u1&#45;&gt;u13</title>
<path fill="none" stroke="black" d="M356.68,-471.88C346.23,-467.63 334.3,-463.44 323,-460.95 290.82,-453.87 49.58,-466.95 27,-442.95 4.16,-418.68 12.6,-398.02 27,-367.95 36.61,-347.88 55.63,-331.97 72.94,-320.81"/>
<polygon fill="black" stroke="black" points="75.07,-323.61 81.77,-315.4 71.41,-317.64 75.07,-323.61"/>
<path fill="none" stroke="black" d="M1206.8,-732.08C1250.56,-718.96 1319.26,-693.39 1366,-651.99 1382.37,-637.49 1394.91,-616.04 1403.06,-599.16"/>
<polygon fill="black" stroke="black" points="1406.35,-600.37 1407.35,-589.82 1399.99,-597.45 1406.35,-600.37"/>
</g>
<!-- u17 -->
<g id="node2" class="node">
<title>u17</title>
<ellipse fill="#bbbbff" stroke="black" stroke-width="0" cx="332" cy="-393.95" rx="30.59" ry="18"/>
<text text-anchor="middle" x="332" y="-390.25" font-family="Times-Roman" font-size="14.00">Utils</text>
<ellipse fill="#bbbbff" stroke="black" stroke-width="0" cx="1267" cy="-571.99" rx="30.59" ry="18"/>
<text text-anchor="middle" x="1267" y="-568.29" font-family="Times-Roman" font-size="14.00">Utils</text>
</g>
<!-- u5 -->
<g id="node6" class="node">
<g id="node23" class="node">
<title>u5</title>
<ellipse fill="#ffbbbb" stroke="black" stroke-width="0" cx="410" cy="-300.95" rx="33.6" ry="18"/>
<text text-anchor="middle" x="410" y="-297.25" font-family="Times-Roman" font-size="14.00">JSON</text>
<ellipse fill="#bbffff" stroke="black" stroke-width="0" cx="1238" cy="-436.99" rx="33.6" ry="18"/>
<text text-anchor="middle" x="1238" y="-433.29" font-family="Times-Roman" font-size="14.00">JSON</text>
</g>
<!-- u17&#45;&gt;u5 -->
<g id="edge16" class="edge">
<g id="edge14" class="edge">
<title>u17&#45;&gt;u5</title>
<path fill="none" stroke="black" d="M345.23,-377.52C357.37,-363.35 375.54,-342.16 389.55,-325.81"/>
<polygon fill="black" stroke="black" points="392.59,-327.64 396.44,-317.77 387.28,-323.09 392.59,-327.64"/>
<path fill="none" stroke="black" d="M1263.27,-553.87C1258.35,-531.33 1249.65,-491.44 1243.86,-464.85"/>
<polygon fill="black" stroke="black" points="1247.27,-464.06 1241.72,-455.04 1240.43,-465.56 1247.27,-464.06"/>
</g>
<!-- u19 -->
<g id="node3" class="node">
<title>u19</title>
<ellipse fill="#bbbbff" stroke="black" stroke-width="0" cx="256" cy="-486.95" rx="57.69" ry="18"/>
<text text-anchor="middle" x="256" y="-483.25" font-family="Times-Roman" font-size="14.00">IOStreams</text>
<ellipse fill="#bbbbff" stroke="black" stroke-width="0" cx="1296" cy="-743.99" rx="57.69" ry="18"/>
<text text-anchor="middle" x="1296" y="-740.29" font-family="Times-Roman" font-size="14.00">IOStreams</text>
</g>
<!-- u19&#45;&gt;u17 -->
<g id="edge17" class="edge">
<g id="edge15" class="edge">
<title>u19&#45;&gt;u17</title>
<path fill="none" stroke="black" d="M272.49,-469.68C280.19,-461.83 289.33,-452.14 297,-442.95 303.18,-435.56 309.51,-427.17 315.06,-419.49"/>
<polygon fill="black" stroke="black" points="318.21,-421.09 321.16,-410.91 312.51,-417.03 318.21,-421.09"/>
</g>
<!-- u3 -->
<g id="node4" class="node">
<title>u3</title>
<ellipse fill="#ffffbb" stroke="black" stroke-width="2" cx="399" cy="-220.95" rx="36.29" ry="18"/>
<text text-anchor="middle" x="399" y="-217.25" font-family="Times-Roman" font-size="14.00">Types</text>
</g>
<!-- u4 -->
<g id="node5" class="node">
<title>u4</title>
<ellipse fill="#ffbbbb" stroke="black" stroke-width="0" cx="319" cy="-300.95" rx="39.79" ry="18"/>
<text text-anchor="middle" x="319" y="-297.25" font-family="Times-Roman" font-size="14.00">Optics</text>
</g>
<!-- u4&#45;&gt;u3 -->
<g id="edge18" class="edge">
<title>u4&#45;&gt;u3</title>
<path fill="none" stroke="black" d="M335.19,-284.17C346.87,-272.78 362.8,-257.24 375.83,-244.55"/>
<polygon fill="black" stroke="black" points="378.39,-246.94 383.11,-237.45 373.5,-241.92 378.39,-246.94"/>
</g>
<!-- u6 -->
<g id="node12" class="node">
<title>u6</title>
<ellipse fill="#bbffff" stroke="black" stroke-width="0" cx="638" cy="-486.95" rx="64.19" ry="18"/>
<text text-anchor="middle" x="638" y="-483.25" font-family="Times-Roman" font-size="14.00">MegaParsec</text>
</g>
<!-- u5&#45;&gt;u6 -->
<g id="edge19" class="edge">
<title>u5&#45;&gt;u6</title>
<path fill="none" stroke="black" d="M425.28,-317.32C443.67,-335.87 472.3,-364.95 474,-367.95 491,-397.97 469.27,-418.9 494,-442.95 518.89,-467.15 536.76,-450.95 570,-460.95 577.45,-463.2 585.27,-465.82 592.85,-468.5"/>
<polygon fill="black" stroke="black" points="591.68,-471.8 602.27,-471.91 594.06,-465.22 591.68,-471.8"/>
</g>
<!-- u7 -->
<g id="node13" class="node">
<title>u7</title>
<ellipse fill="#bbffff" stroke="black" stroke-width="0" cx="618" cy="-220.95" rx="44.39" ry="18"/>
<text text-anchor="middle" x="618" y="-217.25" font-family="Times-Roman" font-size="14.00">Prelude</text>
</g>
<!-- u5&#45;&gt;u7 -->
<g id="edge20" class="edge">
<title>u5&#45;&gt;u7</title>
<path fill="none" stroke="black" d="M429.11,-285.89C434.97,-281.99 441.58,-277.99 448,-274.95 487.67,-256.18 535.63,-241.92 570.48,-232.95"/>
<polygon fill="black" stroke="black" points="571.56,-236.29 580.4,-230.45 569.85,-229.51 571.56,-236.29"/>
</g>
<!-- u9 -->
<g id="node8" class="node">
<title>u9</title>
<ellipse fill="#ffbbff" stroke="black" stroke-width="0" cx="699" cy="-300.95" rx="51.19" ry="18"/>
<text text-anchor="middle" x="699" y="-297.25" font-family="Times-Roman" font-size="14.00">Common</text>
</g>
<!-- u12&#45;&gt;u9 -->
<g id="edge30" class="edge">
<title>u12&#45;&gt;u9</title>
<path fill="none" stroke="black" d="M690.07,-375.84C691.65,-362.75 693.87,-344.43 695.69,-329.32"/>
<polygon fill="black" stroke="black" points="699.21,-329.34 696.94,-318.99 692.27,-328.5 699.21,-329.34"/>
</g>
<!-- u9&#45;&gt;u7 -->
<g id="edge31" class="edge">
<title>u9&#45;&gt;u7</title>
<path fill="none" stroke="black" d="M682.22,-283.79C670.52,-272.53 654.74,-257.34 641.76,-244.83"/>
<polygon fill="black" stroke="black" points="644.12,-242.24 634.48,-237.83 639.26,-247.29 644.12,-242.24"/>
</g>
<!-- u10 -->
<g id="node9" class="node">
<title>u10</title>
<ellipse fill="#77ff77" stroke="black" stroke-width="0" cx="618" cy="-55.95" rx="27" ry="18"/>
<text text-anchor="middle" x="618" y="-52.25" font-family="Times-Roman" font-size="14.00">QQ</text>
</g>
<!-- u16 -->
<g id="node10" class="node">
<title>u16</title>
<ellipse fill="#ffff77" stroke="black" stroke-width="0" cx="747" cy="-486.95" rx="27" ry="18"/>
<text text-anchor="middle" x="747" y="-483.25" font-family="Times-Roman" font-size="14.00">QQ</text>
</g>
<!-- u15 -->
<g id="node11" class="node">
<title>u15</title>
<ellipse fill="#ffffbb" stroke="black" stroke-width="2" cx="823" cy="-486.95" rx="30.59" ry="18"/>
<text text-anchor="middle" x="823" y="-483.25" font-family="Times-Roman" font-size="14.00">Utils</text>
</g>
<!-- u15&#45;&gt;u12 -->
<g id="edge22" class="edge">
<title>u15&#45;&gt;u12</title>
<path fill="none" stroke="black" d="M803.42,-472.71C797.8,-468.92 791.66,-464.77 786,-460.95 761.96,-444.74 734.59,-426.31 714.9,-413.05"/>
<polygon fill="black" stroke="black" points="716.68,-410.03 706.43,-407.35 712.77,-415.84 716.68,-410.03"/>
</g>
<!-- u15&#45;&gt;u11 -->
<g id="edge21" class="edge">
<title>u15&#45;&gt;u11</title>
<path fill="none" stroke="black" d="M805.88,-471.91C799.92,-467.72 792.97,-463.55 786,-460.95 723.08,-437.5 693.45,-477.7 636,-442.95 627.23,-437.65 620.23,-429.02 614.98,-420.54"/>
<polygon fill="black" stroke="black" points="617.89,-418.57 609.96,-411.54 611.78,-421.98 617.89,-418.57"/>
</g>
<!-- u6&#45;&gt;u3 -->
<g id="edge23" class="edge">
<title>u6&#45;&gt;u3</title>
<path fill="none" stroke="black" d="M608.52,-470.77C594.78,-463.16 578.53,-453.36 565,-442.95 527.38,-414.03 523.93,-400.08 489,-367.95 479.95,-359.63 474.21,-360.56 468,-349.95 450.82,-320.62 469.18,-304.85 453,-274.95 446.44,-262.83 436.18,-251.74 426.36,-242.87"/>
<polygon fill="black" stroke="black" points="428.53,-240.12 418.66,-236.26 423.97,-245.43 428.53,-240.12"/>
</g>
<!-- u8 -->
<g id="node14" class="node">
<title>u8</title>
<ellipse fill="#bbffff" stroke="black" stroke-width="0" cx="618" cy="-139.95" rx="42.49" ry="18"/>
<text text-anchor="middle" x="618" y="-136.25" font-family="Times-Roman" font-size="14.00">Logger</text>
</g>
<!-- u7&#45;&gt;u8 -->
<g id="edge25" class="edge">
<title>u7&#45;&gt;u8</title>
<path fill="none" stroke="black" stroke-dasharray="5,2" d="M618,-202.81C618,-192.67 618,-179.59 618,-168.07"/>
<polygon fill="black" stroke="black" points="621.5,-168.06 618,-158.06 614.5,-168.06 621.5,-168.06"/>
</g>
<!-- u2 -->
<g id="node17" class="node">
<title>u2</title>
<ellipse fill="#ffffbb" stroke="black" stroke-width="0" cx="520" cy="-300.95" rx="37.89" ry="18"/>
<text text-anchor="middle" x="520" y="-297.25" font-family="Times-Roman" font-size="14.00">Errors</text>
</g>
<!-- u7&#45;&gt;u2 -->
<g id="edge24" class="edge">
<title>u7&#45;&gt;u2</title>
<path fill="none" stroke="black" d="M598.83,-237.21C584.07,-248.96 563.49,-265.34 547.06,-278.42"/>
<polygon fill="black" stroke="black" points="544.54,-275.95 538.9,-284.91 548.9,-281.43 544.54,-275.95"/>
</g>
<!-- u8&#45;&gt;u4 -->
<g id="edge26" class="edge">
<title>u8&#45;&gt;u4</title>
<path fill="none" stroke="black" d="M576.88,-144.38C511.17,-150.66 386.55,-166.09 354,-194.95 331.93,-214.52 323.74,-248.37 320.73,-272.34"/>
<polygon fill="black" stroke="black" points="317.22,-272.27 319.67,-282.57 324.18,-272.99 317.22,-272.27"/>
</g>
<!-- u8&#45;&gt;u9 -->
<g id="edge27" class="edge">
<title>u8&#45;&gt;u9</title>
<path fill="none" stroke="black" stroke-dasharray="5,2" d="M637.21,-156.09C648.59,-166.01 662.41,-179.89 671,-194.95 684.9,-219.32 692.1,-250.8 695.69,-272.91"/>
<polygon fill="black" stroke="black" points="692.25,-273.56 697.18,-282.94 699.17,-272.53 692.25,-273.56"/>
</g>
<!-- u8&#45;&gt;u10 -->
<g id="edge28" class="edge">
<title>u8&#45;&gt;u10</title>
<path fill="none" stroke="black" d="M618,-121.56C618,-110.73 618,-96.56 618,-84.25"/>
<polygon fill="black" stroke="black" points="621.5,-84.04 618,-74.04 614.5,-84.04 621.5,-84.04"/>
</g>
<!-- u11&#45;&gt;u5 -->
<g id="edge29" class="edge">
<title>u11&#45;&gt;u5</title>
<path fill="none" stroke="black" d="M575.99,-387.58C537.44,-379.55 469,-363.89 448,-349.95 439.06,-344.02 431.26,-335.31 425.1,-326.92"/>
<polygon fill="black" stroke="black" points="427.82,-324.71 419.28,-318.44 422.05,-328.67 427.82,-324.71"/>
</g>
<!-- u0 -->
<g id="node16" class="node">
<title>u0</title>
<ellipse fill="#bbffbb" stroke="black" stroke-width="2" cx="627" cy="-605.95" rx="42.49" ry="18"/>
<text text-anchor="middle" x="627" y="-602.25" font-family="Times-Roman" font-size="14.00">GHCup</text>
</g>
<!-- u0&#45;&gt;u1 -->
<g id="edge4" class="edge">
<title>u0&#45;&gt;u1</title>
<path fill="none" stroke="black" d="M584.67,-604.4C545.83,-602.07 488.09,-593.82 446,-566.95 425.91,-554.13 410.22,-531.89 400.09,-514.27"/>
<polygon fill="black" stroke="black" points="402.91,-512.13 395.04,-505.04 396.77,-515.5 402.91,-512.13"/>
</g>
<!-- u0&#45;&gt;u16 -->
<g id="edge6" class="edge">
<title>u0&#45;&gt;u16</title>
<path fill="none" stroke="black" d="M663.33,-596.57C681.18,-590.83 701.84,-581.54 716,-566.95 729.77,-552.77 737.62,-531.76 741.97,-514.97"/>
<polygon fill="black" stroke="black" points="745.4,-515.69 744.26,-505.16 738.58,-514.11 745.4,-515.69"/>
</g>
<!-- u0&#45;&gt;u15 -->
<g id="edge5" class="edge">
<title>u0&#45;&gt;u15</title>
<path fill="none" stroke="black" d="M669.23,-604.64C704.08,-602.27 753,-593.85 786,-566.95 801.95,-553.96 811.39,-532.52 816.74,-515.25"/>
<polygon fill="black" stroke="black" points="820.24,-515.72 819.56,-505.15 813.5,-513.84 820.24,-515.72"/>
</g>
<!-- u14 -->
<g id="node19" class="node">
<title>u14</title>
<ellipse fill="#ffffbb" stroke="black" stroke-width="0" cx="508" cy="-486.95" rx="48.19" ry="18"/>
<text text-anchor="middle" x="508" y="-483.25" font-family="Times-Roman" font-size="14.00">Platform</text>
</g>
<!-- u0&#45;&gt;u14 -->
<g id="edge3" class="edge">
<title>u0&#45;&gt;u14</title>
<path fill="none" stroke="black" d="M599.25,-592.23C586.98,-585.76 572.9,-577.11 562,-566.95 545.64,-551.71 531.56,-530.66 521.88,-514.12"/>
<polygon fill="black" stroke="black" points="524.68,-511.96 516.71,-504.98 518.59,-515.41 524.68,-511.96"/>
</g>
<!-- u2&#45;&gt;u3 -->
<g id="edge7" class="edge">
<title>u2&#45;&gt;u3</title>
<path fill="none" stroke="black" d="M498.37,-286.01C479.01,-273.53 450.45,-255.12 428.91,-241.23"/>
<polygon fill="black" stroke="black" points="430.75,-238.25 420.45,-235.78 426.95,-244.14 430.75,-238.25"/>
</g>
<!-- u13&#45;&gt;u3 -->
<g id="edge8" class="edge">
<title>u13&#45;&gt;u3</title>
<path fill="none" stroke="black" d="M144.85,-290.31C198.89,-275.78 300.93,-248.33 357.9,-233.01"/>
<polygon fill="black" stroke="black" points="358.91,-236.36 367.66,-230.38 357.09,-229.6 358.91,-236.36"/>
</g>
<!-- u14&#45;&gt;u5 -->
<g id="edge9" class="edge">
<title>u14&#45;&gt;u5</title>
<path fill="none" stroke="black" d="M492.36,-469.49C485.88,-461.9 478.78,-452.48 474,-442.95 458.54,-412.12 468.2,-399.39 454,-367.95 447.34,-353.21 437.53,-338.1 428.85,-326.06"/>
<polygon fill="black" stroke="black" points="431.57,-323.84 422.81,-317.89 425.94,-328.01 431.57,-323.84"/>
</g>
<!-- u14&#45;&gt;u12 -->
<g id="edge10" class="edge">
<title>u14&#45;&gt;u12</title>
<path fill="none" stroke="black" d="M534.95,-471.89C543.43,-467.9 552.95,-463.86 562,-460.95 602.92,-447.83 621.35,-466.95 657,-442.95 665.13,-437.48 671.61,-429.08 676.49,-420.83"/>
<polygon fill="black" stroke="black" points="679.72,-422.21 681.33,-411.74 673.54,-418.92 679.72,-422.21"/>
</g>
<!-- u18 -->
<g id="node20" class="node">
<title>u18</title>
<ellipse fill="#ffffbb" stroke="black" stroke-width="0" cx="109" cy="-393.95" rx="73.39" ry="18"/>
<text text-anchor="middle" x="109" y="-390.25" font-family="Times-Roman" font-size="14.00">Requirements</text>
</g>
<!-- u18&#45;&gt;u5 -->
<g id="edge12" class="edge">
<title>u18&#45;&gt;u5</title>
<path fill="none" stroke="black" d="M147.73,-378.58C159.84,-374.58 173.34,-370.6 186,-367.95 265.56,-351.31 295.73,-387.15 368,-349.95 378.45,-344.58 387.45,-335.41 394.41,-326.53"/>
<polygon fill="black" stroke="black" points="397.39,-328.37 400.44,-318.22 391.73,-324.26 397.39,-328.37"/>
</g>
<!-- u18&#45;&gt;u13 -->
<g id="edge11" class="edge">
<title>u18&#45;&gt;u13</title>
<path fill="none" stroke="black" d="M109,-375.84C109,-362.75 109,-344.43 109,-329.32"/>
<polygon fill="black" stroke="black" points="112.5,-328.99 109,-318.99 105.5,-328.99 112.5,-328.99"/>
</g>
<!-- u20 -->
<g id="node21" class="node">
<title>u20</title>
<ellipse fill="#bbffbb" stroke="black" stroke-width="0" cx="627" cy="-769.95" rx="32.49" ry="18"/>
<text text-anchor="middle" x="627" y="-766.25" font-family="Times-Roman" font-size="14.00">Main</text>
<path fill="none" stroke="black" d="M1293.06,-725.75C1288.01,-696.15 1277.65,-635.42 1271.63,-600.1"/>
<polygon fill="black" stroke="black" points="1275.04,-599.29 1269.9,-590.02 1268.14,-600.46 1275.04,-599.29"/>
</g>
<!-- u21 -->
<g id="node22" class="node">
<g id="node4" class="node">
<title>u21</title>
<ellipse fill="#bbffbb" stroke="black" stroke-width="0" cx="627" cy="-689.95" rx="46.29" ry="18"/>
<text text-anchor="middle" x="627" y="-686.25" font-family="Times-Roman" font-size="14.00">Validate</text>
<ellipse fill="#ffffbb" stroke="black" stroke-width="2" cx="742" cy="-1215.99" rx="51.99" ry="18"/>
<text text-anchor="middle" x="742" y="-1212.29" font-family="Times-Roman" font-size="14.00">OptParse</text>
</g>
<!-- u23 -->
<g id="node6" class="node">
<title>u23</title>
<ellipse fill="#ffbbbb" stroke="black" stroke-width="0" cx="846" cy="-1098.99" rx="38.19" ry="18"/>
<text text-anchor="middle" x="846" y="-1095.29" font-family="Times-Roman" font-size="14.00">Install</text>
</g>
<!-- u21&#45;&gt;u23 -->
<g id="edge16" class="edge">
<title>u21&#45;&gt;u23</title>
<path fill="none" stroke="black" d="M756.9,-1198.51C774.61,-1178.93 804.29,-1146.11 824.49,-1123.77"/>
<polygon fill="black" stroke="black" points="827.35,-1125.83 831.46,-1116.07 822.16,-1121.13 827.35,-1125.83"/>
</g>
<!-- u24 -->
<g id="node7" class="node">
<title>u24</title>
<ellipse fill="#ffbbbb" stroke="black" stroke-width="0" cx="929" cy="-1098.99" rx="27" ry="18"/>
<text text-anchor="middle" x="929" y="-1095.29" font-family="Times-Roman" font-size="14.00">Set</text>
</g>
<!-- u21&#45;&gt;u24 -->
<g id="edge17" class="edge">
<title>u21&#45;&gt;u24</title>
<path fill="none" stroke="black" d="M766.45,-1199.96C801.13,-1178.63 864.45,-1139.69 900.98,-1117.22"/>
<polygon fill="black" stroke="black" points="902.97,-1120.1 909.66,-1111.88 899.31,-1114.14 902.97,-1120.1"/>
</g>
<!-- u25 -->
<g id="node8" class="node">
<title>u25</title>
<ellipse fill="#ffbbbb" stroke="black" stroke-width="0" cx="1197" cy="-1098.99" rx="38.19" ry="18"/>
<text text-anchor="middle" x="1197" y="-1095.29" font-family="Times-Roman" font-size="14.00">UnSet</text>
</g>
<!-- u21&#45;&gt;u25 -->
<g id="edge18" class="edge">
<title>u21&#45;&gt;u25</title>
<path fill="none" stroke="black" d="M785.46,-1206.08C860.33,-1190.39 1018.18,-1155.79 1149,-1116.99 1152.09,-1116.07 1155.28,-1115.07 1158.47,-1114.03"/>
<polygon fill="black" stroke="black" points="1159.62,-1117.34 1167.97,-1110.82 1157.37,-1110.7 1159.62,-1117.34"/>
</g>
<!-- u26 -->
<g id="node9" class="node">
<title>u26</title>
<ellipse fill="#ffbbbb" stroke="black" stroke-width="0" cx="1001" cy="-1098.99" rx="27" ry="18"/>
<text text-anchor="middle" x="1001" y="-1095.29" font-family="Times-Roman" font-size="14.00">Rm</text>
</g>
<!-- u21&#45;&gt;u26 -->
<g id="edge19" class="edge">
<title>u21&#45;&gt;u26</title>
<path fill="none" stroke="black" d="M773.51,-1201.46C816.81,-1182.8 897.08,-1147.94 965,-1116.99 966.79,-1116.17 968.63,-1115.33 970.49,-1114.47"/>
<polygon fill="black" stroke="black" points="972.15,-1117.56 979.72,-1110.15 969.18,-1111.21 972.15,-1117.56"/>
</g>
<!-- u27 -->
<g id="node10" class="node">
<title>u27</title>
<ellipse fill="#ffbbbb" stroke="black" stroke-width="0" cx="1093" cy="-1098.99" rx="47.39" ry="18"/>
<text text-anchor="middle" x="1093" y="-1095.29" font-family="Times-Roman" font-size="14.00">Compile</text>
</g>
<!-- u21&#45;&gt;u27 -->
<g id="edge20" class="edge">
<title>u21&#45;&gt;u27</title>
<path fill="none" stroke="black" d="M778.57,-1203.01C843.42,-1181.76 978.33,-1137.56 1048.47,-1114.58"/>
<polygon fill="black" stroke="black" points="1049.92,-1117.79 1058.34,-1111.35 1047.74,-1111.13 1049.92,-1117.79"/>
</g>
<!-- u28 -->
<g id="node11" class="node">
<title>u28</title>
<ellipse fill="#ffbbbb" stroke="black" stroke-width="0" cx="64" cy="-1098.99" rx="40.09" ry="18"/>
<text text-anchor="middle" x="64" y="-1095.29" font-family="Times-Roman" font-size="14.00">Config</text>
</g>
<!-- u21&#45;&gt;u28 -->
<g id="edge21" class="edge">
<title>u21&#45;&gt;u28</title>
<path fill="none" stroke="black" d="M692.47,-1210.33C585.48,-1199.59 325.33,-1169.91 113,-1116.99 109.85,-1116.21 106.62,-1115.31 103.4,-1114.34"/>
<polygon fill="black" stroke="black" points="104.39,-1110.98 93.8,-1111.28 102.27,-1117.65 104.39,-1110.98"/>
</g>
<!-- u29 -->
<g id="node12" class="node">
<title>u29</title>
<ellipse fill="#ffbbbb" stroke="black" stroke-width="0" cx="415" cy="-1098.99" rx="46.59" ry="18"/>
<text text-anchor="middle" x="415" y="-1095.29" font-family="Times-Roman" font-size="14.00">Whereis</text>
</g>
<!-- u21&#45;&gt;u29 -->
<g id="edge22" class="edge">
<title>u21&#45;&gt;u29</title>
<path fill="none" stroke="black" d="M706.69,-1202.57C646.37,-1181.36 523.67,-1138.21 458.29,-1115.21"/>
<polygon fill="black" stroke="black" points="459.28,-1111.85 448.69,-1111.84 456.96,-1118.46 459.28,-1111.85"/>
</g>
<!-- u30 -->
<g id="node13" class="node">
<title>u30</title>
<ellipse fill="#ffbbbb" stroke="black" stroke-width="0" cx="507" cy="-1098.99" rx="27" ry="18"/>
<text text-anchor="middle" x="507" y="-1095.29" font-family="Times-Roman" font-size="14.00">List</text>
</g>
<!-- u21&#45;&gt;u30 -->
<g id="edge23" class="edge">
<title>u21&#45;&gt;u30</title>
<path fill="none" stroke="black" d="M713.18,-1200.89C668.44,-1178.99 582.69,-1137.03 537.15,-1114.75"/>
<polygon fill="black" stroke="black" points="538.6,-1111.55 528.07,-1110.3 535.52,-1117.84 538.6,-1111.55"/>
</g>
<!-- u31 -->
<g id="node14" class="node">
<title>u31</title>
<ellipse fill="#ffbbbb" stroke="black" stroke-width="0" cx="1303" cy="-1098.99" rx="50.09" ry="18"/>
<text text-anchor="middle" x="1303" y="-1095.29" font-family="Times-Roman" font-size="14.00">Upgrade</text>
</g>
<!-- u21&#45;&gt;u31 -->
<g id="edge24" class="edge">
<title>u21&#45;&gt;u31</title>
<path fill="none" stroke="black" d="M787.97,-1207.41C876.68,-1192.47 1077.4,-1157.17 1244,-1116.99 1248.02,-1116.02 1252.18,-1114.95 1256.34,-1113.84"/>
<polygon fill="black" stroke="black" points="1257.28,-1117.21 1265.99,-1111.19 1255.42,-1110.46 1257.28,-1117.21"/>
</g>
<!-- u32 -->
<g id="node15" class="node">
<title>u32</title>
<ellipse fill="#ffbbbb" stroke="black" stroke-width="0" cx="614" cy="-1098.99" rx="61.99" ry="18"/>
<text text-anchor="middle" x="614" y="-1095.29" font-family="Times-Roman" font-size="14.00">ChangeLog</text>
</g>
<!-- u21&#45;&gt;u32 -->
<g id="edge25" class="edge">
<title>u21&#45;&gt;u32</title>
<path fill="none" stroke="black" d="M724.2,-1199C702.26,-1179.29 664.8,-1145.63 639.73,-1123.11"/>
<polygon fill="black" stroke="black" points="641.84,-1120.29 632.06,-1116.21 637.16,-1125.5 641.84,-1120.29"/>
</g>
<!-- u33 -->
<g id="node16" class="node">
<title>u33</title>
<ellipse fill="#ffbbbb" stroke="black" stroke-width="0" cx="742" cy="-1098.99" rx="48.19" ry="18"/>
<text text-anchor="middle" x="742" y="-1095.29" font-family="Times-Roman" font-size="14.00">Prefetch</text>
</g>
<!-- u21&#45;&gt;u33 -->
<g id="edge26" class="edge">
<title>u21&#45;&gt;u33</title>
<path fill="none" stroke="black" d="M742,-1197.52C742,-1178.93 742,-1149.23 742,-1127.49"/>
<polygon fill="black" stroke="black" points="745.5,-1127.24 742,-1117.24 738.5,-1127.24 745.5,-1127.24"/>
</g>
<!-- u34 -->
<g id="node17" class="node">
<title>u34</title>
<ellipse fill="#ffbbbb" stroke="black" stroke-width="0" cx="235" cy="-1098.99" rx="27" ry="18"/>
<text text-anchor="middle" x="235" y="-1095.29" font-family="Times-Roman" font-size="14.00">GC</text>
</g>
<!-- u21&#45;&gt;u34 -->
<g id="edge27" class="edge">
<title>u21&#45;&gt;u34</title>
<path fill="none" stroke="black" d="M694.23,-1208.86C608.04,-1196.96 421.48,-1167.38 271,-1116.99 269.08,-1116.35 267.13,-1115.63 265.19,-1114.86"/>
<polygon fill="black" stroke="black" points="266.16,-1111.47 255.6,-1110.73 263.4,-1117.9 266.16,-1111.47"/>
</g>
<!-- u35 -->
<g id="node18" class="node">
<title>u35</title>
<ellipse fill="#ffbbbb" stroke="black" stroke-width="0" cx="315" cy="-1098.99" rx="35.19" ry="18"/>
<text text-anchor="middle" x="315" y="-1095.29" font-family="Times-Roman" font-size="14.00">DInfo</text>
</g>
<!-- u21&#45;&gt;u35 -->
<g id="edge28" class="edge">
<title>u21&#45;&gt;u35</title>
<path fill="none" stroke="black" d="M699.03,-1205.74C627.68,-1189.99 480.59,-1155.89 359,-1116.99 356.46,-1116.18 353.84,-1115.29 351.23,-1114.37"/>
<polygon fill="black" stroke="black" points="352.41,-1111.08 341.81,-1110.93 350,-1117.65 352.41,-1111.08"/>
</g>
<!-- u36 -->
<g id="node19" class="node">
<title>u36</title>
<ellipse fill="#ffbbbb" stroke="black" stroke-width="0" cx="1461" cy="-1098.99" rx="90.18" ry="18"/>
<text text-anchor="middle" x="1461" y="-1095.29" font-family="Times-Roman" font-size="14.00">ToolRequirements</text>
</g>
<!-- u21&#45;&gt;u36 -->
<g id="edge29" class="edge">
<title>u21&#45;&gt;u36</title>
<path fill="none" stroke="black" d="M788.7,-1207.83C892.07,-1191.92 1148.03,-1152.27 1362,-1116.99 1369.56,-1115.74 1377.44,-1114.42 1385.32,-1113.09"/>
<polygon fill="black" stroke="black" points="1385.98,-1116.53 1395.25,-1111.41 1384.81,-1109.63 1385.98,-1116.53"/>
</g>
<!-- u37 -->
<g id="node20" class="node">
<title>u37</title>
<ellipse fill="#ffbbbb" stroke="black" stroke-width="0" cx="156" cy="-1098.99" rx="33.6" ry="18"/>
<text text-anchor="middle" x="156" y="-1095.29" font-family="Times-Roman" font-size="14.00">Nuke</text>
</g>
<!-- u21&#45;&gt;u37 -->
<g id="edge30" class="edge">
<title>u21&#45;&gt;u37</title>
<path fill="none" stroke="black" d="M693.33,-1209.49C597.41,-1197.93 377.73,-1167.91 199,-1116.99 196.41,-1116.25 193.76,-1115.42 191.12,-1114.52"/>
<polygon fill="black" stroke="black" points="192.23,-1111.2 181.64,-1111.08 189.84,-1117.78 192.23,-1111.2"/>
</g>
<!-- u22 -->
<g id="node5" class="node">
<title>u22</title>
<ellipse fill="#ffbbbb" stroke="black" stroke-width="0" cx="742" cy="-981.99" rx="51.19" ry="18"/>
<text text-anchor="middle" x="742" y="-978.29" font-family="Times-Roman" font-size="14.00">Common</text>
</g>
<!-- u0 -->
<g id="node33" class="node">
<title>u0</title>
<ellipse fill="#bbffbb" stroke="black" stroke-width="2" cx="705" cy="-864.99" rx="42.49" ry="18"/>
<text text-anchor="middle" x="705" y="-861.29" font-family="Times-Roman" font-size="14.00">GHCup</text>
</g>
<!-- u22&#45;&gt;u0 -->
<g id="edge31" class="edge">
<title>u22&#45;&gt;u0</title>
<path fill="none" stroke="black" d="M736.54,-964.02C730.5,-945.25 720.69,-914.76 713.61,-892.76"/>
<polygon fill="black" stroke="black" points="716.88,-891.48 710.48,-883.03 710.21,-893.62 716.88,-891.48"/>
</g>
<!-- u23&#45;&gt;u22 -->
<g id="edge32" class="edge">
<title>u23&#45;&gt;u22</title>
<path fill="none" stroke="black" d="M831.54,-1082C813.97,-1062.57 784.14,-1029.59 763.78,-1007.08"/>
<polygon fill="black" stroke="black" points="766.31,-1004.66 757.01,-999.59 761.12,-1009.35 766.31,-1004.66"/>
</g>
<!-- u24&#45;&gt;u22 -->
<g id="edge33" class="edge">
<title>u24&#45;&gt;u22</title>
<path fill="none" stroke="black" d="M909.69,-1086.12C877.99,-1066.62 814.52,-1027.58 775.4,-1003.53"/>
<polygon fill="black" stroke="black" points="776.84,-1000.31 766.49,-998.05 773.18,-1006.27 776.84,-1000.31"/>
</g>
<!-- u25&#45;&gt;u0 -->
<g id="edge34" class="edge">
<title>u25&#45;&gt;u0</title>
<path fill="none" stroke="black" d="M1170.9,-1085.68C1088.88,-1047.01 836.24,-927.88 741.44,-883.17"/>
<polygon fill="black" stroke="black" points="742.78,-879.94 732.24,-878.84 739.8,-886.27 742.78,-879.94"/>
</g>
<!-- u26&#45;&gt;u22 -->
<g id="edge35" class="edge">
<title>u26&#45;&gt;u22</title>
<path fill="none" stroke="black" d="M979.72,-1087.83C974.89,-1085.55 969.78,-1083.17 965,-1080.99 901.54,-1052.07 827.31,-1019.75 782.51,-1000.4"/>
<polygon fill="black" stroke="black" points="783.71,-997.11 773.14,-996.36 780.94,-1003.53 783.71,-997.11"/>
</g>
<!-- u27&#45;&gt;u22 -->
<g id="edge36" class="edge">
<title>u27&#45;&gt;u22</title>
<path fill="none" stroke="black" d="M1058.38,-1086.65C994.71,-1065.79 859,-1021.32 787.79,-997.99"/>
<polygon fill="black" stroke="black" points="788.78,-994.63 778.19,-994.85 786.6,-1001.29 788.78,-994.63"/>
</g>
<!-- u15 -->
<g id="node28" class="node">
<title>u15</title>
<ellipse fill="#ffffbb" stroke="black" stroke-width="2" cx="705" cy="-571.99" rx="30.59" ry="18"/>
<text text-anchor="middle" x="705" y="-568.29" font-family="Times-Roman" font-size="14.00">Utils</text>
</g>
<!-- u28&#45;&gt;u15 -->
<g id="edge37" class="edge">
<title>u28&#45;&gt;u15</title>
<path fill="none" stroke="black" d="M67.99,-1080.83C82.87,-1020.89 141.11,-819.44 271,-725.99 416.7,-621.17 526.05,-761.83 668,-651.99 684.52,-639.21 693.98,-617.26 699.19,-599.74"/>
<polygon fill="black" stroke="black" points="702.58,-600.61 701.79,-590.04 695.82,-598.8 702.58,-600.61"/>
</g>
<!-- u29&#45;&gt;u22 -->
<g id="edge38" class="edge">
<title>u29&#45;&gt;u22</title>
<path fill="none" stroke="black" d="M448.46,-1086.22C507.6,-1065.42 630.64,-1022.15 697.09,-998.78"/>
<polygon fill="black" stroke="black" points="698.59,-1001.97 706.86,-995.35 696.27,-995.36 698.59,-1001.97"/>
</g>
<!-- u30&#45;&gt;u22 -->
<g id="edge39" class="edge">
<title>u30&#45;&gt;u22</title>
<path fill="none" stroke="black" d="M528.27,-1087.58C568.07,-1068.1 654.29,-1025.91 704.21,-1001.48"/>
<polygon fill="black" stroke="black" points="705.94,-1004.53 713.38,-996.99 702.86,-998.25 705.94,-1004.53"/>
</g>
<!-- u31&#45;&gt;u0 -->
<g id="edge40" class="edge">
<title>u31&#45;&gt;u0</title>
<path fill="none" stroke="black" d="M1271.29,-1084.99C1209.35,-1059.66 1067.86,-1002.15 948,-955.99 877.11,-928.69 794.01,-898.24 745.65,-880.68"/>
<polygon fill="black" stroke="black" points="746.76,-877.36 736.17,-877.24 744.37,-883.94 746.76,-877.36"/>
</g>
<!-- u32&#45;&gt;u22 -->
<g id="edge41" class="edge">
<title>u32&#45;&gt;u22</title>
<path fill="none" stroke="black" d="M632.07,-1081.76C654.08,-1061.98 691.42,-1028.44 716.39,-1006"/>
<polygon fill="black" stroke="black" points="718.92,-1008.43 724.02,-999.14 714.25,-1003.22 718.92,-1008.43"/>
</g>
<!-- u33&#45;&gt;u22 -->
<g id="edge42" class="edge">
<title>u33&#45;&gt;u22</title>
<path fill="none" stroke="black" d="M742,-1080.52C742,-1061.93 742,-1032.23 742,-1010.49"/>
<polygon fill="black" stroke="black" points="745.5,-1010.24 742,-1000.24 738.5,-1010.24 745.5,-1010.24"/>
</g>
<!-- u34&#45;&gt;u0 -->
<g id="edge43" class="edge">
<title>u34&#45;&gt;u0</title>
<path fill="none" stroke="black" d="M253.73,-1086.02C294.34,-1060.34 393.93,-998.82 482,-955.99 543.91,-925.88 618.59,-897.22 663.9,-880.63"/>
<polygon fill="black" stroke="black" points="665.18,-883.89 673.38,-877.18 662.79,-877.31 665.18,-883.89"/>
</g>
<!-- u35&#45;&gt;u0 -->
<g id="edge44" class="edge">
<title>u35&#45;&gt;u0</title>
<path fill="none" stroke="black" d="M337.09,-1084.85C402.43,-1045.98 595.06,-931.39 672.36,-885.41"/>
<polygon fill="black" stroke="black" points="674.39,-888.27 681.2,-880.15 670.81,-882.25 674.39,-888.27"/>
</g>
<!-- u14 -->
<g id="node36" class="node">
<title>u14</title>
<ellipse fill="#ffffbb" stroke="black" stroke-width="0" cx="934" cy="-743.99" rx="48.19" ry="18"/>
<text text-anchor="middle" x="934" y="-740.29" font-family="Times-Roman" font-size="14.00">Platform</text>
</g>
<!-- u36&#45;&gt;u14 -->
<g id="edge45" class="edge">
<title>u36&#45;&gt;u14</title>
<path fill="none" stroke="black" d="M1436.29,-1081.44C1349.76,-1023.48 1060.5,-829.72 964.94,-765.71"/>
<polygon fill="black" stroke="black" points="966.82,-762.76 956.56,-760.1 962.93,-768.58 966.82,-762.76"/>
</g>
<!-- u18 -->
<g id="node37" class="node">
<title>u18</title>
<ellipse fill="#ffffbb" stroke="black" stroke-width="0" cx="1461" cy="-743.99" rx="73.39" ry="18"/>
<text text-anchor="middle" x="1461" y="-740.29" font-family="Times-Roman" font-size="14.00">Requirements</text>
</g>
<!-- u36&#45;&gt;u18 -->
<g id="edge46" class="edge">
<title>u36&#45;&gt;u18</title>
<path fill="none" stroke="black" d="M1461,-1080.96C1461,-1024.36 1461,-842.13 1461,-772.44"/>
<polygon fill="black" stroke="black" points="1464.5,-772.26 1461,-762.26 1457.5,-772.26 1464.5,-772.26"/>
</g>
<!-- u37&#45;&gt;u0 -->
<g id="edge47" class="edge">
<title>u37&#45;&gt;u0</title>
<path fill="none" stroke="black" d="M175.44,-1084.01C214.9,-1056.2 307.95,-993.37 394,-955.99 483.86,-916.95 595.52,-889.35 657.64,-875.71"/>
<polygon fill="black" stroke="black" points="658.52,-879.1 667.55,-873.56 657.03,-872.26 658.52,-879.1"/>
</g>
<!-- u3 -->
<g id="node21" class="node">
<title>u3</title>
<ellipse fill="#ffffbb" stroke="black" stroke-width="2" cx="1257" cy="-319.99" rx="36.29" ry="18"/>
<text text-anchor="middle" x="1257" y="-316.29" font-family="Times-Roman" font-size="14.00">Types</text>
</g>
<!-- u4 -->
<g id="node22" class="node">
<title>u4</title>
<ellipse fill="#bbffff" stroke="black" stroke-width="0" cx="1329" cy="-436.99" rx="39.79" ry="18"/>
<text text-anchor="middle" x="1329" y="-433.29" font-family="Times-Roman" font-size="14.00">Optics</text>
</g>
<!-- u4&#45;&gt;u3 -->
<g id="edge48" class="edge">
<title>u4&#45;&gt;u3</title>
<path fill="none" stroke="black" d="M1318.68,-419.51C1306.65,-400.3 1286.64,-368.33 1272.68,-346.04"/>
<polygon fill="black" stroke="black" points="1275.57,-344.05 1267.3,-337.44 1269.64,-347.77 1275.57,-344.05"/>
</g>
<!-- u6 -->
<g id="node29" class="node">
<title>u6</title>
<ellipse fill="#ffbbff" stroke="black" stroke-width="0" cx="934" cy="-571.99" rx="64.19" ry="18"/>
<text text-anchor="middle" x="934" y="-568.29" font-family="Times-Roman" font-size="14.00">MegaParsec</text>
</g>
<!-- u5&#45;&gt;u6 -->
<g id="edge49" class="edge">
<title>u5&#45;&gt;u6</title>
<path fill="none" stroke="black" d="M1225.64,-453.75C1216.72,-464.19 1203.86,-477.47 1190,-485.99 1117.08,-530.81 1088.16,-518.79 1007,-545.99 999.06,-548.65 990.64,-551.5 982.45,-554.3"/>
<polygon fill="black" stroke="black" points="981.32,-550.99 972.99,-557.53 983.58,-557.61 981.32,-550.99"/>
</g>
<!-- u7 -->
<g id="node30" class="node">
<title>u7</title>
<ellipse fill="#ffbbff" stroke="black" stroke-width="0" cx="1030" cy="-319.99" rx="44.39" ry="18"/>
<text text-anchor="middle" x="1030" y="-316.29" font-family="Times-Roman" font-size="14.00">Prelude</text>
</g>
<!-- u5&#45;&gt;u7 -->
<g id="edge50" class="edge">
<title>u5&#45;&gt;u7</title>
<path fill="none" stroke="black" d="M1218.11,-422.39C1212.34,-418.59 1205.98,-414.53 1200,-410.99 1154.95,-384.33 1101.33,-356.57 1066.52,-339.06"/>
<polygon fill="black" stroke="black" points="1067.74,-335.75 1057.23,-334.4 1064.6,-342.01 1067.74,-335.75"/>
</g>
<!-- u9 -->
<g id="node25" class="node">
<title>u9</title>
<ellipse fill="#77ff77" stroke="black" stroke-width="0" cx="803" cy="-436.99" rx="51.19" ry="18"/>
<text text-anchor="middle" x="803" y="-433.29" font-family="Times-Roman" font-size="14.00">Common</text>
</g>
<!-- u12&#45;&gt;u9 -->
<g id="edge59" class="edge">
<title>u12&#45;&gt;u9</title>
<path fill="none" stroke="black" d="M822.17,-553.87C818.46,-531.43 811.9,-491.79 807.5,-465.2"/>
<polygon fill="black" stroke="black" points="810.91,-464.33 805.82,-455.04 804,-465.48 810.91,-464.33"/>
</g>
<!-- u9&#45;&gt;u7 -->
<g id="edge60" class="edge">
<title>u9&#45;&gt;u7</title>
<path fill="none" stroke="black" d="M831.29,-421.66C872.57,-400.75 949.27,-361.89 994.36,-339.05"/>
<polygon fill="black" stroke="black" points="996.13,-342.07 1003.47,-334.43 992.97,-335.83 996.13,-342.07"/>
</g>
<!-- u10 -->
<g id="node26" class="node">
<title>u10</title>
<ellipse fill="#ffff77" stroke="black" stroke-width="0" cx="1030" cy="-80.99" rx="27" ry="18"/>
<text text-anchor="middle" x="1030" y="-77.29" font-family="Times-Roman" font-size="14.00">QQ</text>
</g>
<!-- u16 -->
<g id="node27" class="node">
<title>u16</title>
<ellipse fill="#7777ff" stroke="black" stroke-width="0" cx="629" cy="-571.99" rx="27" ry="18"/>
<text text-anchor="middle" x="629" y="-568.29" font-family="Times-Roman" font-size="14.00">QQ</text>
</g>
<!-- u15&#45;&gt;u1 -->
<g id="edge51" class="edge">
<title>u15&#45;&gt;u1</title>
<path fill="none" stroke="black" d="M707.81,-589.96C711.74,-608.15 720.7,-636.49 740,-651.99 869.4,-755.91 944.8,-686.54 1106,-725.99 1109.21,-726.78 1112.51,-727.62 1115.82,-728.5"/>
<polygon fill="black" stroke="black" points="1115.2,-731.95 1125.77,-731.2 1117.04,-725.2 1115.2,-731.95"/>
</g>
<!-- u6&#45;&gt;u3 -->
<g id="edge52" class="edge">
<title>u6&#45;&gt;u3</title>
<path fill="none" stroke="black" d="M972.89,-557.62C1042.12,-533.81 1179.56,-486.5 1180,-485.99 1202.36,-460.38 1181.75,-442.3 1195,-410.99 1205.36,-386.51 1222.94,-361.88 1236.75,-344.58"/>
<polygon fill="black" stroke="black" points="1239.56,-346.68 1243.17,-336.72 1234.13,-342.25 1239.56,-346.68"/>
</g>
<!-- u8 -->
<g id="node31" class="node">
<title>u8</title>
<ellipse fill="#ffbbff" stroke="black" stroke-width="0" cx="1030" cy="-202.99" rx="42.49" ry="18"/>
<text text-anchor="middle" x="1030" y="-199.29" font-family="Times-Roman" font-size="14.00">Logger</text>
</g>
<!-- u7&#45;&gt;u8 -->
<g id="edge54" class="edge">
<title>u7&#45;&gt;u8</title>
<path fill="none" stroke="black" stroke-dasharray="5,2" d="M1030,-301.52C1030,-282.93 1030,-253.23 1030,-231.49"/>
<polygon fill="black" stroke="black" points="1033.5,-231.24 1030,-221.24 1026.5,-231.24 1033.5,-231.24"/>
</g>
<!-- u2 -->
<g id="node34" class="node">
<title>u2</title>
<ellipse fill="#ffffbb" stroke="black" stroke-width="0" cx="1128" cy="-436.99" rx="37.89" ry="18"/>
<text text-anchor="middle" x="1128" y="-433.29" font-family="Times-Roman" font-size="14.00">Errors</text>
</g>
<!-- u7&#45;&gt;u2 -->
<g id="edge53" class="edge">
<title>u7&#45;&gt;u2</title>
<path fill="none" stroke="black" d="M1043.83,-337.21C1060.5,-356.78 1088.66,-389.83 1107.78,-412.26"/>
<polygon fill="black" stroke="black" points="1105.22,-414.66 1114.37,-420 1110.55,-410.12 1105.22,-414.66"/>
</g>
<!-- u8&#45;&gt;u4 -->
<g id="edge55" class="edge">
<title>u8&#45;&gt;u4</title>
<path fill="none" stroke="black" d="M1072.08,-205.27C1132.49,-209.51 1242.99,-226.65 1302,-293.99 1329.81,-325.73 1332.74,-377.05 1331.47,-408.52"/>
<polygon fill="black" stroke="black" points="1327.96,-408.58 1330.88,-418.77 1334.95,-408.98 1327.96,-408.58"/>
</g>
<!-- u8&#45;&gt;u9 -->
<g id="edge56" class="edge">
<title>u8&#45;&gt;u9</title>
<path fill="none" stroke="black" stroke-dasharray="5,2" d="M1014.36,-219.98C975.12,-260.08 872.38,-365.08 826.14,-412.34"/>
<polygon fill="black" stroke="black" points="823.45,-410.08 818.96,-419.68 828.46,-414.98 823.45,-410.08"/>
</g>
<!-- u8&#45;&gt;u10 -->
<g id="edge57" class="edge">
<title>u8&#45;&gt;u10</title>
<path fill="none" stroke="black" d="M1030,-184.8C1030,-165.1 1030,-132.57 1030,-109.38"/>
<polygon fill="black" stroke="black" points="1033.5,-109.15 1030,-99.15 1026.5,-109.15 1033.5,-109.15"/>
</g>
<!-- u11&#45;&gt;u5 -->
<g id="edge58" class="edge">
<title>u11&#45;&gt;u5</title>
<path fill="none" stroke="black" d="M1062.1,-557.23C1067.11,-553.42 1072.68,-549.4 1078,-545.99 1125.54,-515.51 1144.66,-519.65 1190,-485.99 1199.71,-478.78 1209.34,-469.64 1217.41,-461.28"/>
<polygon fill="black" stroke="black" points="1220.04,-463.58 1224.33,-453.89 1214.94,-458.8 1220.04,-463.58"/>
</g>
<!-- u0&#45;&gt;u16 -->
<g id="edge4" class="edge">
<title>u0&#45;&gt;u16</title>
<path fill="none" stroke="black" d="M700.59,-847.09C687.91,-798.57 651.35,-658.57 635.96,-599.64"/>
<polygon fill="black" stroke="black" points="639.34,-598.73 633.43,-589.94 632.57,-600.5 639.34,-598.73"/>
</g>
<!-- u0&#45;&gt;u15 -->
<g id="edge3" class="edge">
<title>u0&#45;&gt;u15</title>
<path fill="none" stroke="black" d="M705,-846.66C705,-797.93 705,-659.45 705,-600.31"/>
<polygon fill="black" stroke="black" points="708.5,-600.23 705,-590.23 701.5,-600.23 708.5,-600.23"/>
</g>
<!-- u0&#45;&gt;u14 -->
<g id="edge2" class="edge">
<title>u0&#45;&gt;u14</title>
<path fill="none" stroke="black" d="M730.82,-850.57C771.64,-829.36 851.2,-788.02 897.73,-763.84"/>
<polygon fill="black" stroke="black" points="899.59,-766.81 906.85,-759.1 896.37,-760.6 899.59,-766.81"/>
</g>
<!-- u2&#45;&gt;u3 -->
<g id="edge5" class="edge">
<title>u2&#45;&gt;u3</title>
<path fill="none" stroke="black" d="M1145.13,-420.72C1167.39,-400.87 1206.44,-366.06 1232.01,-343.27"/>
<polygon fill="black" stroke="black" points="1234.66,-345.59 1239.8,-336.32 1230.01,-340.37 1234.66,-345.59"/>
</g>
<!-- u13&#45;&gt;u3 -->
<g id="edge6" class="edge">
<title>u13&#45;&gt;u3</title>
<path fill="none" stroke="black" d="M1413.93,-553.61C1413.03,-522.51 1407.48,-456.35 1378,-410.99 1356.72,-378.25 1319.17,-353.11 1291.53,-337.83"/>
<polygon fill="black" stroke="black" points="1293.04,-334.67 1282.57,-333.03 1289.73,-340.84 1293.04,-334.67"/>
</g>
<!-- u14&#45;&gt;u5 -->
<g id="edge7" class="edge">
<title>u14&#45;&gt;u5</title>
<path fill="none" stroke="black" d="M970.19,-731.9C1005.99,-718.88 1059.19,-693.62 1086,-651.99 1111.67,-612.13 1073.1,-586.34 1098,-545.99 1123.63,-504.44 1152.09,-516.75 1190,-485.99 1199.39,-478.37 1208.96,-469.15 1217.06,-460.83"/>
<polygon fill="black" stroke="black" points="1219.67,-463.17 1224.04,-453.52 1214.6,-458.34 1219.67,-463.17"/>
</g>
<!-- u14&#45;&gt;u12 -->
<g id="edge8" class="edge">
<title>u14&#45;&gt;u12</title>
<path fill="none" stroke="black" d="M917.2,-726.88C899.99,-709.65 873.37,-680.88 856,-651.99 846.1,-635.52 838.24,-615.33 832.91,-599.48"/>
<polygon fill="black" stroke="black" points="836.18,-598.22 829.78,-589.77 829.52,-600.36 836.18,-598.22"/>
</g>
<!-- u18&#45;&gt;u5 -->
<g id="edge10" class="edge">
<title>u18&#45;&gt;u5</title>
<path fill="none" stroke="black" d="M1467.83,-725.94C1481.37,-689.08 1507.02,-600.87 1467,-545.99 1415.57,-475.47 1352.95,-533.91 1280,-485.99 1270.56,-479.79 1261.98,-470.91 1255.06,-462.47"/>
<polygon fill="black" stroke="black" points="1257.62,-460.06 1248.74,-454.29 1252.09,-464.34 1257.62,-460.06"/>
</g>
<!-- u18&#45;&gt;u13 -->
<g id="edge9" class="edge">
<title>u18&#45;&gt;u13</title>
<path fill="none" stroke="black" d="M1456.23,-725.75C1448.05,-696.15 1431.26,-635.42 1421.5,-600.1"/>
<polygon fill="black" stroke="black" points="1424.75,-598.72 1418.71,-590.02 1418,-600.59 1424.75,-598.72"/>
</g>
<!-- u20 -->
<g id="node38" class="node">
<title>u20</title>
<ellipse fill="#bbffbb" stroke="black" stroke-width="0" cx="742" cy="-1387.99" rx="32.49" ry="18"/>
<text text-anchor="middle" x="742" y="-1384.29" font-family="Times-Roman" font-size="14.00">Main</text>
</g>
<!-- u20&#45;&gt;u21 -->
<g id="edge1" class="edge">
<title>u20&#45;&gt;u21</title>
<path fill="none" stroke="black" d="M627,-751.64C627,-741.85 627,-729.38 627,-718.29"/>
<polygon fill="black" stroke="black" points="630.5,-718.22 627,-708.22 623.5,-718.22 630.5,-718.22"/>
</g>
<!-- u21&#45;&gt;u0 -->
<g id="edge2" class="edge">
<title>u21&#45;&gt;u0</title>
<path fill="none" stroke="black" d="M627,-671.56C627,-660.73 627,-646.56 627,-634.25"/>
<polygon fill="black" stroke="black" points="630.5,-634.04 627,-624.04 623.5,-634.04 630.5,-634.04"/>
<path fill="none" stroke="black" d="M742,-1369.75C742,-1340.15 742,-1279.42 742,-1244.1"/>
<polygon fill="black" stroke="black" points="745.5,-1244.02 742,-1234.02 738.5,-1244.02 745.5,-1244.02"/>
</g>
</g>
</svg>

Before

Width:  |  Height:  |  Size: 19 KiB

After

Width:  |  Height:  |  Size: 32 KiB

View File

@@ -4,363 +4,638 @@
<!-- Generated by graphviz version 2.44.0 (0)
-->
<!-- Title: G Pages: 1 -->
<svg width="1075pt" height="648pt"
viewBox="0.00 0.00 1075.16 648.00" xmlns="http://www.w3.org/2000/svg" xmlns:xlink="http://www.w3.org/1999/xlink">
<g id="graph0" class="graph" transform="scale(0.91 0.91) rotate(0) translate(4 710)">
<svg width="1076pt" height="648pt"
viewBox="0.00 0.00 1076.37 648.00" xmlns="http://www.w3.org/2000/svg" xmlns:xlink="http://www.w3.org/1999/xlink">
<g id="graph0" class="graph" transform="scale(0.68 0.68) rotate(0) translate(4 949)">
<title>G</title>
<polygon fill="white" stroke="transparent" points="-4,4 -4,-710 1180.67,-710 1180.67,4 -4,4"/>
<polygon fill="white" stroke="transparent" points="-4,4 -4,-949 1579,-949 1579,4 -4,4"/>
<g id="clust1" class="cluster">
<title>cluster_0</title>
<polygon fill="#000000" fill-opacity="0.058824" stroke="#000000" stroke-opacity="0.058824" points="10.72,-8 10.72,-590 1165.95,-590 1165.95,-8 10.72,-8"/>
<text text-anchor="middle" x="588.33" y="-574.8" font-family="Times-Roman" font-size="14.00">GHCup</text>
<polygon fill="#000000" fill-opacity="0.058824" stroke="#000000" stroke-opacity="0.058824" points="8,-8.66 8,-897.37 1567,-897.37 1567,-8.66 8,-8.66"/>
<text text-anchor="middle" x="787.5" y="-882.17" font-family="Times-Roman" font-size="14.00">GHCup</text>
</g>
<g id="clust2" class="cluster">
<title>cluster_1</title>
<polygon fill="#000000" fill-opacity="0.058824" stroke="#000000" stroke-opacity="0.058824" points="254.63,-326 254.63,-484 603.08,-484 603.08,-326 254.63,-326"/>
<text text-anchor="middle" x="428.85" y="-468.8" font-family="Times-Roman" font-size="14.00">Download</text>
<polygon fill="#000000" fill-opacity="0.058824" stroke="#000000" stroke-opacity="0.058824" points="1102,-352.89 1102,-548.81 1362,-548.81 1362,-352.89 1102,-352.89"/>
<text text-anchor="middle" x="1232" y="-533.61" font-family="Times-Roman" font-size="14.00">Download</text>
</g>
<g id="clust3" class="cluster">
<title>cluster_2</title>
<polygon fill="#000000" fill-opacity="0.058824" stroke="#000000" stroke-opacity="0.058824" points="363.19,-171 363.19,-318 605.76,-318 605.76,-171 363.19,-171"/>
<text text-anchor="middle" x="484.47" y="-302.8" font-family="Times-Roman" font-size="14.00">Types</text>
<polygon fill="#000000" fill-opacity="0.058824" stroke="#000000" stroke-opacity="0.058824" points="16,-626.75 16,-863.81 1559,-863.81 1559,-626.75 16,-626.75"/>
<text text-anchor="middle" x="787.5" y="-848.61" font-family="Times-Roman" font-size="14.00">OptParse</text>
</g>
<g id="clust4" class="cluster">
<title>cluster_3</title>
<polygon fill="#000000" fill-opacity="0.058824" stroke="#000000" stroke-opacity="0.058824" points="758.53,-16 758.53,-515 1155.22,-515 1155.22,-16 758.53,-16"/>
<text text-anchor="middle" x="956.88" y="-499.8" font-family="Times-Roman" font-size="14.00">Utils</text>
<polygon fill="#000000" fill-opacity="0.058824" stroke="#000000" stroke-opacity="0.058824" points="1196,-185.1 1196,-344.23 1377,-344.23 1377,-185.1 1196,-185.1"/>
<text text-anchor="middle" x="1286.5" y="-329.03" font-family="Times-Roman" font-size="14.00">Types</text>
</g>
<g id="clust5" class="cluster">
<title>cluster_4</title>
<polygon fill="#000000" fill-opacity="0.058824" stroke="#000000" stroke-opacity="0.058824" points="857.71,-243 857.71,-401 1015.85,-401 1015.85,-243 857.71,-243"/>
<text text-anchor="middle" x="936.78" y="-385.8" font-family="Times-Roman" font-size="14.00">File</text>
<polygon fill="#000000" fill-opacity="0.058824" stroke="#000000" stroke-opacity="0.058824" points="586,-17.32 586,-467.63 1082,-467.63 1082,-17.32 586,-17.32"/>
<text text-anchor="middle" x="834" y="-452.43" font-family="Times-Roman" font-size="14.00">Utils</text>
</g>
<g id="clust6" class="cluster">
<title>cluster_5</title>
<polygon fill="#000000" fill-opacity="0.058824" stroke="#000000" stroke-opacity="0.058824" points="781.32,-24 781.32,-99 875.13,-99 875.13,-24 781.32,-24"/>
<text text-anchor="middle" x="828.22" y="-83.8" font-family="Times-Roman" font-size="14.00">String</text>
<polygon fill="#000000" fill-opacity="0.058824" stroke="#000000" stroke-opacity="0.058824" points="744,-263.04 744,-434.07 862,-434.07 862,-263.04 744,-263.04"/>
<text text-anchor="middle" x="803" y="-418.87" font-family="Times-Roman" font-size="14.00">File</text>
</g>
<g id="clust7" class="cluster">
<title>cluster_6</title>
<polygon fill="#000000" fill-opacity="0.058824" stroke="#000000" stroke-opacity="0.058824" points="954.2,-409 954.2,-484 1048.01,-484 1048.01,-409 954.2,-409"/>
<text text-anchor="middle" x="1001.1" y="-468.8" font-family="Times-Roman" font-size="14.00">Version</text>
<polygon fill="#000000" fill-opacity="0.058824" stroke="#000000" stroke-opacity="0.058824" points="995,-25.98 995,-107.16 1065,-107.16 1065,-25.98 995,-25.98"/>
<text text-anchor="middle" x="1030" y="-91.96" font-family="Times-Roman" font-size="14.00">String</text>
</g>
<g id="clust8" class="cluster">
<title>cluster_7</title>
<polygon fill="#000000" fill-opacity="0.058824" stroke="#000000" stroke-opacity="0.058824" points="594,-352.89 594,-434.07 664,-434.07 664,-352.89 594,-352.89"/>
<text text-anchor="middle" x="629" y="-418.87" font-family="Times-Roman" font-size="14.00">Version</text>
</g>
<!-- u1 -->
<g id="node1" class="node">
<title>u1</title>
<ellipse fill="#ffffbb" stroke="black" stroke-width="2" cx="518.39" cy="-435" rx="55.49" ry="18"/>
<text text-anchor="middle" x="518.39" y="-431.3" font-family="Times-Roman" font-size="14.00">Download</text>
<ellipse fill="#ffffbb" stroke="black" stroke-width="2" cx="1165" cy="-495.66" rx="55.49" ry="18"/>
<text text-anchor="middle" x="1165" y="-491.96" font-family="Times-Roman" font-size="14.00">Download</text>
</g>
<!-- u12 -->
<g id="node7" class="node">
<g id="node24" class="node">
<title>u12</title>
<ellipse fill="#bbffff" stroke="black" stroke-width="2" cx="922.39" cy="-352" rx="27" ry="18"/>
<text text-anchor="middle" x="922.39" y="-348.3" font-family="Times-Roman" font-size="14.00">File</text>
<ellipse fill="#ffbbff" stroke="black" stroke-width="2" cx="825" cy="-380.66" rx="27" ry="18"/>
<text text-anchor="middle" x="825" y="-376.96" font-family="Times-Roman" font-size="14.00">File</text>
</g>
<!-- u1&#45;&gt;u12 -->
<g id="edge15" class="edge">
<g id="edge13" class="edge">
<title>u1&#45;&gt;u12</title>
<path fill="none" stroke="black" d="M546.79,-419.43C556.27,-415.25 567.06,-411.24 577.39,-409 594.44,-405.31 876.17,-409.54 891.39,-401 900.16,-396.08 906.84,-387.53 911.72,-379"/>
<polygon fill="black" stroke="black" points="914.92,-380.43 916.31,-369.92 908.67,-377.26 914.92,-380.43"/>
<path fill="none" stroke="black" d="M1127.19,-482.48C1120.21,-480.6 1112.93,-478.88 1106,-477.66 1078.58,-472.83 878.46,-477.12 856,-460.66 839.51,-448.58 831.79,-426.38 828.17,-408.59"/>
<polygon fill="black" stroke="black" points="831.62,-407.99 826.49,-398.73 824.72,-409.17 831.62,-407.99"/>
</g>
<!-- u11 -->
<g id="node15" class="node">
<g id="node32" class="node">
<title>u11</title>
<ellipse fill="#bbffff" stroke="black" stroke-width="0" cx="808.39" cy="-352" rx="28.7" ry="18"/>
<text text-anchor="middle" x="808.39" y="-348.3" font-family="Times-Roman" font-size="14.00">Dirs</text>
<ellipse fill="#ffbbff" stroke="black" stroke-width="0" cx="1045" cy="-380.66" rx="28.7" ry="18"/>
<text text-anchor="middle" x="1045" y="-376.96" font-family="Times-Roman" font-size="14.00">Dirs</text>
</g>
<!-- u1&#45;&gt;u11 -->
<g id="edge14" class="edge">
<g id="edge12" class="edge">
<title>u1&#45;&gt;u11</title>
<path fill="none" stroke="black" d="M548.95,-419.93C557.99,-416.08 567.99,-412.11 577.39,-409 586.69,-405.92 709.34,-376.59 772.03,-361.65"/>
<polygon fill="black" stroke="black" points="772.99,-365.02 781.91,-359.3 771.37,-358.21 772.99,-365.02"/>
<path fill="none" stroke="black" d="M1130.87,-481.48C1119.63,-476.1 1107.57,-469.13 1098,-460.66 1081.15,-445.74 1067.22,-424.32 1057.88,-407.55"/>
<polygon fill="black" stroke="black" points="1060.73,-405.46 1052.92,-398.3 1054.56,-408.76 1060.73,-405.46"/>
</g>
<!-- u13 -->
<g id="node18" class="node">
<g id="node35" class="node">
<title>u13</title>
<ellipse fill="#ffffbb" stroke="black" stroke-width="0" cx="146.39" cy="-269" rx="44.39" ry="18"/>
<text text-anchor="middle" x="146.39" y="-265.3" font-family="Times-Roman" font-size="14.00">Version</text>
<ellipse fill="#ffffbb" stroke="black" stroke-width="0" cx="1414" cy="-380.66" rx="44.39" ry="18"/>
<text text-anchor="middle" x="1414" y="-376.96" font-family="Times-Roman" font-size="14.00">Version</text>
</g>
<!-- u1&#45;&gt;u13 -->
<g id="edge13" class="edge">
<g id="edge11" class="edge">
<title>u1&#45;&gt;u13</title>
<path fill="none" stroke="black" d="M477.97,-422.58C457.84,-417.42 433.02,-411.85 410.39,-409 400.85,-407.8 71.11,-407.88 64.39,-401 41.09,-377.16 48.83,-355.48 64.39,-326 73.49,-308.76 90.55,-295.83 106.76,-286.76"/>
<polygon fill="black" stroke="black" points="108.39,-289.86 115.62,-282.11 105.14,-283.66 108.39,-289.86"/>
<path fill="none" stroke="black" d="M1205.09,-483.12C1212.97,-481.1 1221.21,-479.17 1229,-477.66 1259.12,-471.82 1340.24,-477.32 1366,-460.66 1384.87,-448.45 1397.46,-425.95 1405,-408.08"/>
<polygon fill="black" stroke="black" points="1408.27,-409.31 1408.67,-398.72 1401.76,-406.75 1408.27,-409.31"/>
</g>
<!-- u17 -->
<g id="node2" class="node">
<title>u17</title>
<ellipse fill="#bbbbff" stroke="black" stroke-width="0" cx="445.39" cy="-352" rx="30.59" ry="18"/>
<text text-anchor="middle" x="445.39" y="-348.3" font-family="Times-Roman" font-size="14.00">Utils</text>
<ellipse fill="#bbbbff" stroke="black" stroke-width="0" cx="1267" cy="-380.66" rx="30.59" ry="18"/>
<text text-anchor="middle" x="1267" y="-376.96" font-family="Times-Roman" font-size="14.00">Utils</text>
</g>
<!-- u5 -->
<g id="node6" class="node">
<g id="node23" class="node">
<title>u5</title>
<ellipse fill="#ffbbbb" stroke="black" stroke-width="0" cx="549.39" cy="-269" rx="33.6" ry="18"/>
<text text-anchor="middle" x="549.39" y="-265.3" font-family="Times-Roman" font-size="14.00">JSON</text>
<ellipse fill="#bbffff" stroke="black" stroke-width="0" cx="1238" cy="-291.66" rx="33.6" ry="18"/>
<text text-anchor="middle" x="1238" y="-287.96" font-family="Times-Roman" font-size="14.00">JSON</text>
</g>
<!-- u17&#45;&gt;u5 -->
<g id="edge16" class="edge">
<g id="edge14" class="edge">
<title>u17&#45;&gt;u5</title>
<path fill="none" stroke="black" d="M463.03,-337.26C479.49,-324.44 504.26,-305.15 523.05,-290.51"/>
<polygon fill="black" stroke="black" points="525.22,-293.26 530.96,-284.35 520.92,-287.74 525.22,-293.26"/>
<path fill="none" stroke="black" d="M1261.41,-362.89C1257.3,-350.57 1251.64,-333.58 1246.91,-319.4"/>
<polygon fill="black" stroke="black" points="1250.16,-318.06 1243.67,-309.68 1243.52,-320.27 1250.16,-318.06"/>
</g>
<!-- u19 -->
<g id="node3" class="node">
<title>u19</title>
<ellipse fill="#bbbbff" stroke="black" stroke-width="0" cx="343.39" cy="-435" rx="57.69" ry="18"/>
<text text-anchor="middle" x="343.39" y="-431.3" font-family="Times-Roman" font-size="14.00">IOStreams</text>
<ellipse fill="#bbbbff" stroke="black" stroke-width="0" cx="1296" cy="-495.66" rx="57.69" ry="18"/>
<text text-anchor="middle" x="1296" y="-491.96" font-family="Times-Roman" font-size="14.00">IOStreams</text>
</g>
<!-- u19&#45;&gt;u17 -->
<g id="edge17" class="edge">
<g id="edge15" class="edge">
<title>u19&#45;&gt;u17</title>
<path fill="none" stroke="black" d="M378.72,-420.5C389.55,-415.38 401.06,-408.84 410.39,-401 418.16,-394.47 425.12,-385.87 430.76,-377.75"/>
<polygon fill="black" stroke="black" points="433.77,-379.54 436.33,-369.25 427.92,-375.7 433.77,-379.54"/>
</g>
<!-- u3 -->
<g id="node4" class="node">
<title>u3</title>
<ellipse fill="#ffffbb" stroke="black" stroke-width="2" cx="534.39" cy="-197" rx="36.29" ry="18"/>
<text text-anchor="middle" x="534.39" y="-193.3" font-family="Times-Roman" font-size="14.00">Types</text>
</g>
<!-- u4 -->
<g id="node5" class="node">
<title>u4</title>
<ellipse fill="#ffbbbb" stroke="black" stroke-width="0" cx="427.39" cy="-269" rx="39.79" ry="18"/>
<text text-anchor="middle" x="427.39" y="-265.3" font-family="Times-Roman" font-size="14.00">Optics</text>
</g>
<!-- u4&#45;&gt;u3 -->
<g id="edge18" class="edge">
<title>u4&#45;&gt;u3</title>
<path fill="none" stroke="black" d="M449.04,-253.83C464.95,-243.42 486.78,-229.15 504.37,-217.64"/>
<polygon fill="black" stroke="black" points="506.68,-220.31 513.13,-211.91 502.85,-214.45 506.68,-220.31"/>
</g>
<!-- u6 -->
<g id="node12" class="node">
<title>u6</title>
<ellipse fill="#bbffff" stroke="black" stroke-width="0" cx="855.39" cy="-435" rx="64.19" ry="18"/>
<text text-anchor="middle" x="855.39" y="-431.3" font-family="Times-Roman" font-size="14.00">MegaParsec</text>
</g>
<!-- u5&#45;&gt;u6 -->
<g id="edge19" class="edge">
<title>u5&#45;&gt;u6</title>
<path fill="none" stroke="black" d="M566.7,-284.68C579.52,-295.01 597.75,-308.62 615.39,-318 624.58,-322.89 630.09,-318.59 637.39,-326 662.15,-351.13 635.32,-379.63 663.39,-401 674.37,-409.36 773.88,-406.14 787.39,-409 795.7,-410.76 804.37,-413.33 812.61,-416.16"/>
<polygon fill="black" stroke="black" points="811.46,-419.47 822.06,-419.57 813.84,-412.88 811.46,-419.47"/>
</g>
<!-- u7 -->
<g id="node13" class="node">
<title>u7</title>
<ellipse fill="#bbffff" stroke="black" stroke-width="0" cx="828.39" cy="-197" rx="44.39" ry="18"/>
<text text-anchor="middle" x="828.39" y="-193.3" font-family="Times-Roman" font-size="14.00">Prelude</text>
</g>
<!-- u5&#45;&gt;u7 -->
<g id="edge20" class="edge">
<title>u5&#45;&gt;u7</title>
<path fill="none" stroke="black" d="M567.9,-253.71C573.85,-249.71 580.65,-245.72 587.39,-243 648.94,-218.19 724.91,-206.91 774.9,-201.88"/>
<polygon fill="black" stroke="black" points="775.54,-205.33 785.16,-200.9 774.87,-198.36 775.54,-205.33"/>
</g>
<!-- u9 -->
<g id="node8" class="node">
<title>u9</title>
<ellipse fill="#ffbbff" stroke="black" stroke-width="0" cx="936.39" cy="-269" rx="51.19" ry="18"/>
<text text-anchor="middle" x="936.39" y="-265.3" font-family="Times-Roman" font-size="14.00">Common</text>
</g>
<!-- u12&#45;&gt;u9 -->
<g id="edge30" class="edge">
<title>u12&#45;&gt;u9</title>
<path fill="none" stroke="black" d="M925.36,-333.82C927.2,-323.19 929.6,-309.31 931.69,-297.2"/>
<polygon fill="black" stroke="black" points="935.17,-297.6 933.42,-287.15 928.27,-296.41 935.17,-297.6"/>
</g>
<!-- u9&#45;&gt;u7 -->
<g id="edge31" class="edge">
<title>u9&#45;&gt;u7</title>
<path fill="none" stroke="black" d="M912.96,-252.81C897.32,-242.68 876.58,-229.24 859.56,-218.2"/>
<polygon fill="black" stroke="black" points="861.33,-215.18 851.04,-212.68 857.53,-221.06 861.33,-215.18"/>
</g>
<!-- u10 -->
<g id="node9" class="node">
<title>u10</title>
<ellipse fill="#77ff77" stroke="black" stroke-width="0" cx="828.39" cy="-50" rx="27" ry="18"/>
<text text-anchor="middle" x="828.39" y="-46.3" font-family="Times-Roman" font-size="14.00">QQ</text>
</g>
<!-- u16 -->
<g id="node10" class="node">
<title>u16</title>
<ellipse fill="#ffff77" stroke="black" stroke-width="0" cx="1001.39" cy="-435" rx="27" ry="18"/>
<text text-anchor="middle" x="1001.39" y="-431.3" font-family="Times-Roman" font-size="14.00">QQ</text>
</g>
<!-- u15 -->
<g id="node11" class="node">
<title>u15</title>
<ellipse fill="#ffffbb" stroke="black" stroke-width="2" cx="1103.39" cy="-435" rx="30.59" ry="18"/>
<text text-anchor="middle" x="1103.39" y="-431.3" font-family="Times-Roman" font-size="14.00">Utils</text>
</g>
<!-- u15&#45;&gt;u12 -->
<g id="edge22" class="edge">
<title>u15&#45;&gt;u12</title>
<path fill="none" stroke="black" d="M1080.91,-422.68C1072.07,-418.31 1061.8,-413.33 1052.39,-409 1019.33,-393.79 981.02,-377.44 954.59,-366.35"/>
<polygon fill="black" stroke="black" points="955.66,-363.01 945.08,-362.38 952.96,-369.47 955.66,-363.01"/>
</g>
<!-- u15&#45;&gt;u11 -->
<g id="edge21" class="edge">
<title>u15&#45;&gt;u11</title>
<path fill="none" stroke="black" d="M1082.81,-421.48C1073.8,-416.65 1062.9,-411.66 1052.39,-409 1009.49,-398.14 893.64,-419.41 853.39,-401 842.1,-395.84 832.28,-386.4 824.72,-377.25"/>
<polygon fill="black" stroke="black" points="827.3,-374.87 818.44,-369.07 821.75,-379.13 827.3,-374.87"/>
</g>
<!-- u6&#45;&gt;u3 -->
<g id="edge23" class="edge">
<title>u6&#45;&gt;u3</title>
<path fill="none" stroke="black" d="M817.86,-420.3C799.34,-413.36 779.12,-405.48 770.39,-401 716.1,-373.14 711.12,-350.84 655.39,-326 642.79,-320.38 635.87,-326.98 625.39,-318 597.74,-294.3 614.8,-271.71 592.39,-243 584.81,-233.29 574.68,-224.49 565.01,-217.31"/>
<polygon fill="black" stroke="black" points="566.89,-214.35 556.71,-211.43 562.85,-220.06 566.89,-214.35"/>
</g>
<!-- u8 -->
<g id="node14" class="node">
<title>u8</title>
<ellipse fill="#bbffff" stroke="black" stroke-width="0" cx="828.39" cy="-125" rx="42.49" ry="18"/>
<text text-anchor="middle" x="828.39" y="-121.3" font-family="Times-Roman" font-size="14.00">Logger</text>
</g>
<!-- u7&#45;&gt;u8 -->
<g id="edge25" class="edge">
<title>u7&#45;&gt;u8</title>
<path fill="none" stroke="black" stroke-dasharray="5,2" d="M828.39,-178.7C828.39,-170.98 828.39,-161.71 828.39,-153.11"/>
<polygon fill="black" stroke="black" points="831.89,-153.1 828.39,-143.1 824.89,-153.1 831.89,-153.1"/>
</g>
<!-- u2 -->
<g id="node17" class="node">
<title>u2</title>
<ellipse fill="#ffffbb" stroke="black" stroke-width="0" cx="696.39" cy="-269" rx="37.89" ry="18"/>
<text text-anchor="middle" x="696.39" y="-265.3" font-family="Times-Roman" font-size="14.00">Errors</text>
</g>
<!-- u7&#45;&gt;u2 -->
<g id="edge24" class="edge">
<title>u7&#45;&gt;u2</title>
<path fill="none" stroke="black" d="M802.53,-211.71C781.65,-222.79 752.12,-238.45 729.51,-250.44"/>
<polygon fill="black" stroke="black" points="727.8,-247.38 720.6,-255.16 731.07,-253.57 727.8,-247.38"/>
</g>
<!-- u8&#45;&gt;u4 -->
<g id="edge26" class="edge">
<title>u8&#45;&gt;u4</title>
<path fill="none" stroke="black" d="M786.3,-127.22C706.73,-130.23 537.84,-140.15 489.39,-171 463.54,-187.46 446.42,-218.99 436.84,-241.64"/>
<polygon fill="black" stroke="black" points="433.54,-240.45 433.08,-251.04 440.04,-243.06 433.54,-240.45"/>
</g>
<!-- u8&#45;&gt;u9 -->
<g id="edge27" class="edge">
<title>u8&#45;&gt;u9</title>
<path fill="none" stroke="black" stroke-dasharray="5,2" d="M849.03,-140.76C859.52,-148.9 872,-159.65 881.39,-171 899.5,-192.89 914.92,-221.56 924.79,-242.04"/>
<polygon fill="black" stroke="black" points="921.62,-243.54 929.04,-251.1 927.96,-240.56 921.62,-243.54"/>
</g>
<!-- u8&#45;&gt;u10 -->
<g id="edge28" class="edge">
<title>u8&#45;&gt;u10</title>
<path fill="none" stroke="black" d="M828.39,-106.7C828.39,-98.25 828.39,-87.87 828.39,-78.37"/>
<polygon fill="black" stroke="black" points="831.89,-78.18 828.39,-68.18 824.89,-78.18 831.89,-78.18"/>
</g>
<!-- u11&#45;&gt;u5 -->
<g id="edge29" class="edge">
<title>u11&#45;&gt;u5</title>
<path fill="none" stroke="black" d="M781.07,-346.57C749.06,-341.43 694.42,-332.79 647.39,-326 620.76,-322.16 610.78,-331.29 587.39,-318 577.83,-312.56 569.78,-303.68 563.6,-295.02"/>
<polygon fill="black" stroke="black" points="566.46,-293 558.04,-286.57 560.61,-296.85 566.46,-293"/>
</g>
<!-- u0 -->
<g id="node16" class="node">
<title>u0</title>
<ellipse fill="#bbffbb" stroke="black" stroke-width="2" cx="840.39" cy="-541" rx="42.49" ry="18"/>
<text text-anchor="middle" x="840.39" y="-537.3" font-family="Times-Roman" font-size="14.00">GHCup</text>
</g>
<!-- u0&#45;&gt;u1 -->
<g id="edge4" class="edge">
<title>u0&#45;&gt;u1</title>
<path fill="none" stroke="black" d="M798.15,-540.08C733.62,-539.53 614.12,-535.65 577.39,-515 556.17,-503.07 540.32,-480.02 530.42,-461.88"/>
<polygon fill="black" stroke="black" points="533.49,-460.2 525.79,-452.93 527.27,-463.42 533.49,-460.2"/>
</g>
<!-- u0&#45;&gt;u16 -->
<g id="edge6" class="edge">
<title>u0&#45;&gt;u16</title>
<path fill="none" stroke="black" d="M881.32,-536.43C914.21,-532.8 957.04,-526.09 970.39,-515 985.87,-502.13 993.66,-480.49 997.55,-463.11"/>
<polygon fill="black" stroke="black" points="1001.06,-463.44 999.51,-452.96 994.18,-462.12 1001.06,-463.44"/>
</g>
<!-- u0&#45;&gt;u15 -->
<g id="edge5" class="edge">
<title>u0&#45;&gt;u15</title>
<path fill="none" stroke="black" d="M882.83,-539.21C936.42,-537.51 1024.95,-532.11 1052.39,-515 1071.91,-502.83 1085.39,-480.12 1093.57,-462.17"/>
<polygon fill="black" stroke="black" points="1096.87,-463.35 1097.57,-452.78 1090.43,-460.6 1096.87,-463.35"/>
</g>
<!-- u14 -->
<g id="node19" class="node">
<title>u14</title>
<ellipse fill="#ffffbb" stroke="black" stroke-width="0" cx="680.39" cy="-435" rx="48.19" ry="18"/>
<text text-anchor="middle" x="680.39" y="-431.3" font-family="Times-Roman" font-size="14.00">Platform</text>
</g>
<!-- u0&#45;&gt;u14 -->
<g id="edge3" class="edge">
<title>u0&#45;&gt;u14</title>
<path fill="none" stroke="black" d="M801.74,-533.4C786.24,-529.61 768.7,-523.78 754.39,-515 731.68,-501.06 711.42,-478.33 697.87,-460.82"/>
<polygon fill="black" stroke="black" points="700.58,-458.59 691.78,-452.7 694.98,-462.8 700.58,-458.59"/>
</g>
<!-- u2&#45;&gt;u3 -->
<g id="edge7" class="edge">
<title>u2&#45;&gt;u3</title>
<path fill="none" stroke="black" d="M669.27,-256.28C642.05,-244.52 599.95,-226.33 570.04,-213.4"/>
<polygon fill="black" stroke="black" points="571.35,-210.16 560.79,-209.41 568.58,-216.59 571.35,-210.16"/>
</g>
<!-- u13&#45;&gt;u3 -->
<g id="edge8" class="edge">
<title>u13&#45;&gt;u3</title>
<path fill="none" stroke="black" d="M186.09,-260.84C259.14,-247.66 414.32,-219.66 490.43,-205.93"/>
<polygon fill="black" stroke="black" points="491.41,-209.31 500.63,-204.09 490.17,-202.42 491.41,-209.31"/>
</g>
<!-- u14&#45;&gt;u5 -->
<g id="edge9" class="edge">
<title>u14&#45;&gt;u5</title>
<path fill="none" stroke="black" d="M656.5,-419.22C649.64,-414.1 642.62,-407.9 637.39,-401 615.71,-372.38 627.41,-355.8 607.39,-326 598.66,-313.01 586.48,-300.68 575.54,-290.91"/>
<polygon fill="black" stroke="black" points="577.72,-288.16 567.86,-284.28 573.14,-293.46 577.72,-288.16"/>
</g>
<!-- u14&#45;&gt;u12 -->
<g id="edge10" class="edge">
<title>u14&#45;&gt;u12</title>
<path fill="none" stroke="black" d="M711.94,-421.27C724.88,-416.59 740.15,-411.77 754.39,-409 784.33,-403.18 865.04,-416.36 891.39,-401 900.07,-395.94 906.74,-387.36 911.63,-378.84"/>
<polygon fill="black" stroke="black" points="914.82,-380.3 916.24,-369.8 908.58,-377.12 914.82,-380.3"/>
</g>
<!-- u18 -->
<g id="node20" class="node">
<title>u18</title>
<ellipse fill="#ffffbb" stroke="black" stroke-width="0" cx="146.39" cy="-352" rx="73.39" ry="18"/>
<text text-anchor="middle" x="146.39" y="-348.3" font-family="Times-Roman" font-size="14.00">Requirements</text>
</g>
<!-- u18&#45;&gt;u5 -->
<g id="edge12" class="edge">
<title>u18&#45;&gt;u5</title>
<path fill="none" stroke="black" d="M192.35,-337.85C210.3,-333.27 231.16,-328.62 250.39,-326 300.18,-319.2 428.51,-333.26 476.39,-318 493.93,-312.41 511.26,-301.32 524.62,-291.22"/>
<polygon fill="black" stroke="black" points="527.1,-293.72 532.79,-284.78 522.77,-288.22 527.1,-293.72"/>
</g>
<!-- u18&#45;&gt;u13 -->
<g id="edge11" class="edge">
<title>u18&#45;&gt;u13</title>
<path fill="none" stroke="black" d="M146.39,-333.82C146.39,-323.19 146.39,-309.31 146.39,-297.2"/>
<polygon fill="black" stroke="black" points="149.89,-297.15 146.39,-287.15 142.89,-297.15 149.89,-297.15"/>
</g>
<!-- u20 -->
<g id="node21" class="node">
<title>u20</title>
<ellipse fill="#bbffbb" stroke="black" stroke-width="0" cx="840.39" cy="-688" rx="32.49" ry="18"/>
<text text-anchor="middle" x="840.39" y="-684.3" font-family="Times-Roman" font-size="14.00">Main</text>
<path fill="none" stroke="black" d="M1291.6,-477.5C1286.88,-459.14 1279.35,-429.78 1273.86,-408.39"/>
<polygon fill="black" stroke="black" points="1277.23,-407.43 1271.35,-398.61 1270.45,-409.17 1277.23,-407.43"/>
</g>
<!-- u21 -->
<g id="node22" class="node">
<g id="node4" class="node">
<title>u21</title>
<ellipse fill="#bbffbb" stroke="black" stroke-width="0" cx="840.39" cy="-616" rx="46.29" ry="18"/>
<text text-anchor="middle" x="840.39" y="-612.3" font-family="Times-Roman" font-size="14.00">Validate</text>
<ellipse fill="#ffffbb" stroke="black" stroke-width="2" cx="742" cy="-810.66" rx="51.99" ry="18"/>
<text text-anchor="middle" x="742" y="-806.96" font-family="Times-Roman" font-size="14.00">OptParse</text>
</g>
<!-- u23 -->
<g id="node6" class="node">
<title>u23</title>
<ellipse fill="#ffbbbb" stroke="black" stroke-width="0" cx="846" cy="-732.66" rx="38.19" ry="18"/>
<text text-anchor="middle" x="846" y="-728.96" font-family="Times-Roman" font-size="14.00">Install</text>
</g>
<!-- u21&#45;&gt;u23 -->
<g id="edge16" class="edge">
<title>u21&#45;&gt;u23</title>
<path fill="none" stroke="black" d="M763.3,-794.1C778.98,-782.63 800.48,-766.92 817.63,-754.39"/>
<polygon fill="black" stroke="black" points="820.13,-756.9 826.14,-748.17 816,-751.25 820.13,-756.9"/>
</g>
<!-- u24 -->
<g id="node7" class="node">
<title>u24</title>
<ellipse fill="#ffbbbb" stroke="black" stroke-width="0" cx="929" cy="-732.66" rx="27" ry="18"/>
<text text-anchor="middle" x="929" y="-728.96" font-family="Times-Roman" font-size="14.00">Set</text>
</g>
<!-- u21&#45;&gt;u24 -->
<g id="edge17" class="edge">
<title>u21&#45;&gt;u24</title>
<path fill="none" stroke="black" d="M776.15,-797.08C806.94,-785.56 853.32,-767.76 893,-750.66 894.81,-749.88 896.66,-749.06 898.53,-748.23"/>
<polygon fill="black" stroke="black" points="900.16,-751.33 907.79,-743.97 897.24,-744.97 900.16,-751.33"/>
</g>
<!-- u25 -->
<g id="node8" class="node">
<title>u25</title>
<ellipse fill="#ffbbbb" stroke="black" stroke-width="0" cx="1197" cy="-732.66" rx="38.19" ry="18"/>
<text text-anchor="middle" x="1197" y="-728.96" font-family="Times-Roman" font-size="14.00">UnSet</text>
</g>
<!-- u21&#45;&gt;u25 -->
<g id="edge18" class="edge">
<title>u21&#45;&gt;u25</title>
<path fill="none" stroke="black" d="M792.1,-805.59C869.52,-798.59 1022.5,-781.91 1149,-750.66 1152.18,-749.88 1155.44,-748.96 1158.69,-747.97"/>
<polygon fill="black" stroke="black" points="1159.91,-751.26 1168.34,-744.84 1157.75,-744.6 1159.91,-751.26"/>
</g>
<!-- u26 -->
<g id="node9" class="node">
<title>u26</title>
<ellipse fill="#ffbbbb" stroke="black" stroke-width="0" cx="1001" cy="-732.66" rx="27" ry="18"/>
<text text-anchor="middle" x="1001" y="-728.96" font-family="Times-Roman" font-size="14.00">Rm</text>
</g>
<!-- u21&#45;&gt;u26 -->
<g id="edge19" class="edge">
<title>u21&#45;&gt;u26</title>
<path fill="none" stroke="black" d="M785.47,-800.63C830.94,-790.62 904.05,-772.9 965,-750.66 966.85,-749.98 968.74,-749.25 970.62,-748.47"/>
<polygon fill="black" stroke="black" points="972.2,-751.6 979.95,-744.38 969.39,-745.19 972.2,-751.6"/>
</g>
<!-- u27 -->
<g id="node10" class="node">
<title>u27</title>
<ellipse fill="#ffbbbb" stroke="black" stroke-width="0" cx="1093" cy="-732.66" rx="47.39" ry="18"/>
<text text-anchor="middle" x="1093" y="-728.96" font-family="Times-Roman" font-size="14.00">Compile</text>
</g>
<!-- u21&#45;&gt;u27 -->
<g id="edge20" class="edge">
<title>u21&#45;&gt;u27</title>
<path fill="none" stroke="black" d="M787.79,-801.93C846.05,-791.76 949.62,-772.61 1037,-750.66 1040.61,-749.75 1044.34,-748.76 1048.07,-747.72"/>
<polygon fill="black" stroke="black" points="1049.25,-751.02 1057.9,-744.89 1047.32,-744.29 1049.25,-751.02"/>
</g>
<!-- u28 -->
<g id="node11" class="node">
<title>u28</title>
<ellipse fill="#ffbbbb" stroke="black" stroke-width="0" cx="64" cy="-732.66" rx="40.09" ry="18"/>
<text text-anchor="middle" x="64" y="-728.96" font-family="Times-Roman" font-size="14.00">Config</text>
</g>
<!-- u21&#45;&gt;u28 -->
<g id="edge21" class="edge">
<title>u21&#45;&gt;u28</title>
<path fill="none" stroke="black" d="M689.99,-808.99C581.5,-806.67 323.62,-796.37 113,-750.66 109.64,-749.93 106.2,-749.04 102.77,-748.06"/>
<polygon fill="black" stroke="black" points="103.8,-744.71 93.21,-745.08 101.72,-751.4 103.8,-744.71"/>
</g>
<!-- u29 -->
<g id="node12" class="node">
<title>u29</title>
<ellipse fill="#ffbbbb" stroke="black" stroke-width="0" cx="415" cy="-732.66" rx="46.59" ry="18"/>
<text text-anchor="middle" x="415" y="-728.96" font-family="Times-Roman" font-size="14.00">Whereis</text>
</g>
<!-- u21&#45;&gt;u29 -->
<g id="edge22" class="edge">
<title>u21&#45;&gt;u29</title>
<path fill="none" stroke="black" d="M697.62,-801.14C643.73,-790.53 550.22,-771.27 471,-750.66 467.24,-749.68 463.35,-748.61 459.45,-747.51"/>
<polygon fill="black" stroke="black" points="460.41,-744.14 449.83,-744.71 458.45,-750.86 460.41,-744.14"/>
</g>
<!-- u30 -->
<g id="node13" class="node">
<title>u30</title>
<ellipse fill="#ffbbbb" stroke="black" stroke-width="0" cx="507" cy="-732.66" rx="27" ry="18"/>
<text text-anchor="middle" x="507" y="-728.96" font-family="Times-Roman" font-size="14.00">List</text>
</g>
<!-- u21&#45;&gt;u30 -->
<g id="edge23" class="edge">
<title>u21&#45;&gt;u30</title>
<path fill="none" stroke="black" d="M700.99,-799.47C660.33,-788.91 596.53,-771.1 543,-750.66 541.16,-749.96 539.28,-749.2 537.4,-748.41"/>
<polygon fill="black" stroke="black" points="538.65,-745.13 528.09,-744.28 535.81,-751.53 538.65,-745.13"/>
</g>
<!-- u31 -->
<g id="node14" class="node">
<title>u31</title>
<ellipse fill="#ffbbbb" stroke="black" stroke-width="0" cx="1303" cy="-732.66" rx="50.09" ry="18"/>
<text text-anchor="middle" x="1303" y="-728.96" font-family="Times-Roman" font-size="14.00">Upgrade</text>
</g>
<!-- u21&#45;&gt;u31 -->
<g id="edge24" class="edge">
<title>u21&#45;&gt;u31</title>
<path fill="none" stroke="black" d="M792.66,-806.46C883.72,-800.09 1080.77,-783.54 1244,-750.66 1248.17,-749.82 1252.48,-748.83 1256.78,-747.75"/>
<polygon fill="black" stroke="black" points="1257.95,-751.06 1266.72,-745.12 1256.16,-744.29 1257.95,-751.06"/>
</g>
<!-- u32 -->
<g id="node15" class="node">
<title>u32</title>
<ellipse fill="#ffbbbb" stroke="black" stroke-width="0" cx="614" cy="-732.66" rx="61.99" ry="18"/>
<text text-anchor="middle" x="614" y="-728.96" font-family="Times-Roman" font-size="14.00">ChangeLog</text>
</g>
<!-- u21&#45;&gt;u32 -->
<g id="edge25" class="edge">
<title>u21&#45;&gt;u32</title>
<path fill="none" stroke="black" d="M717.02,-794.83C697.66,-783.34 670.61,-767.27 649.09,-754.49"/>
<polygon fill="black" stroke="black" points="650.63,-751.34 640.24,-749.24 647.05,-757.36 650.63,-751.34"/>
</g>
<!-- u33 -->
<g id="node16" class="node">
<title>u33</title>
<ellipse fill="#ffbbbb" stroke="black" stroke-width="0" cx="742" cy="-732.66" rx="48.19" ry="18"/>
<text text-anchor="middle" x="742" y="-728.96" font-family="Times-Roman" font-size="14.00">Prefetch</text>
</g>
<!-- u21&#45;&gt;u33 -->
<g id="edge26" class="edge">
<title>u21&#45;&gt;u33</title>
<path fill="none" stroke="black" d="M742,-792.41C742,-783.18 742,-771.59 742,-761.15"/>
<polygon fill="black" stroke="black" points="745.5,-760.84 742,-750.84 738.5,-760.84 745.5,-760.84"/>
</g>
<!-- u34 -->
<g id="node17" class="node">
<title>u34</title>
<ellipse fill="#ffbbbb" stroke="black" stroke-width="0" cx="235" cy="-732.66" rx="27" ry="18"/>
<text text-anchor="middle" x="235" y="-728.96" font-family="Times-Roman" font-size="14.00">GC</text>
</g>
<!-- u21&#45;&gt;u34 -->
<g id="edge27" class="edge">
<title>u21&#45;&gt;u34</title>
<path fill="none" stroke="black" d="M690.05,-808.49C602.09,-805.33 418.98,-793.68 271,-750.66 269.06,-750.1 267.09,-749.44 265.13,-748.72"/>
<polygon fill="black" stroke="black" points="266.08,-745.32 255.5,-744.7 263.39,-751.78 266.08,-745.32"/>
</g>
<!-- u35 -->
<g id="node18" class="node">
<title>u35</title>
<ellipse fill="#ffbbbb" stroke="black" stroke-width="0" cx="315" cy="-732.66" rx="35.19" ry="18"/>
<text text-anchor="middle" x="315" y="-728.96" font-family="Times-Roman" font-size="14.00">DInfo</text>
</g>
<!-- u21&#45;&gt;u35 -->
<g id="edge28" class="edge">
<title>u21&#45;&gt;u35</title>
<path fill="none" stroke="black" d="M692.02,-805.43C618.22,-798.41 476.17,-781.93 359,-750.66 356.35,-749.95 353.63,-749.14 350.92,-748.26"/>
<polygon fill="black" stroke="black" points="351.81,-744.86 341.22,-744.85 349.49,-751.47 351.81,-744.86"/>
</g>
<!-- u36 -->
<g id="node19" class="node">
<title>u36</title>
<ellipse fill="#ffbbbb" stroke="black" stroke-width="0" cx="1461" cy="-732.66" rx="90.18" ry="18"/>
<text text-anchor="middle" x="1461" y="-728.96" font-family="Times-Roman" font-size="14.00">ToolRequirements</text>
</g>
<!-- u21&#45;&gt;u36 -->
<g id="edge29" class="edge">
<title>u21&#45;&gt;u36</title>
<path fill="none" stroke="black" d="M792.37,-806.16C898.17,-798.52 1151.13,-778.76 1362,-750.66 1370.05,-749.59 1378.45,-748.34 1386.8,-747.02"/>
<polygon fill="black" stroke="black" points="1387.62,-750.44 1396.94,-745.38 1386.51,-743.53 1387.62,-750.44"/>
</g>
<!-- u37 -->
<g id="node20" class="node">
<title>u37</title>
<ellipse fill="#ffbbbb" stroke="black" stroke-width="0" cx="156" cy="-732.66" rx="33.6" ry="18"/>
<text text-anchor="middle" x="156" y="-728.96" font-family="Times-Roman" font-size="14.00">Nuke</text>
</g>
<!-- u21&#45;&gt;u37 -->
<g id="edge30" class="edge">
<title>u21&#45;&gt;u37</title>
<path fill="none" stroke="black" d="M690.3,-808.63C592.81,-805.69 375.74,-794.35 199,-750.66 196.22,-749.97 193.39,-749.15 190.56,-748.24"/>
<polygon fill="black" stroke="black" points="191.69,-744.93 181.1,-744.88 189.35,-751.52 191.69,-744.93"/>
</g>
<!-- u22 -->
<g id="node5" class="node">
<title>u22</title>
<ellipse fill="#ffbbbb" stroke="black" stroke-width="0" cx="742" cy="-654.66" rx="51.19" ry="18"/>
<text text-anchor="middle" x="742" y="-650.96" font-family="Times-Roman" font-size="14.00">Common</text>
</g>
<!-- u0 -->
<g id="node33" class="node">
<title>u0</title>
<ellipse fill="#bbffbb" stroke="black" stroke-width="2" cx="705" cy="-576.66" rx="42.49" ry="18"/>
<text text-anchor="middle" x="705" y="-572.96" font-family="Times-Roman" font-size="14.00">GHCup</text>
</g>
<!-- u22&#45;&gt;u0 -->
<g id="edge31" class="edge">
<title>u22&#45;&gt;u0</title>
<path fill="none" stroke="black" d="M733.79,-636.79C729.05,-627.05 722.98,-614.59 717.64,-603.63"/>
<polygon fill="black" stroke="black" points="720.71,-601.94 713.19,-594.48 714.42,-605 720.71,-601.94"/>
</g>
<!-- u23&#45;&gt;u22 -->
<g id="edge32" class="edge">
<title>u23&#45;&gt;u22</title>
<path fill="none" stroke="black" d="M825.95,-717.01C810.53,-705.74 788.99,-690 771.59,-677.28"/>
<polygon fill="black" stroke="black" points="773.56,-674.39 763.42,-671.31 769.43,-680.04 773.56,-674.39"/>
</g>
<!-- u24&#45;&gt;u22 -->
<g id="edge33" class="edge">
<title>u24&#45;&gt;u22</title>
<path fill="none" stroke="black" d="M907.79,-721.35C902.96,-719.08 897.82,-716.74 893,-714.66 857.2,-699.23 815.93,-683.23 785.6,-671.79"/>
<polygon fill="black" stroke="black" points="786.75,-668.48 776.15,-668.24 784.29,-675.03 786.75,-668.48"/>
</g>
<!-- u25&#45;&gt;u0 -->
<g id="edge34" class="edge">
<title>u25&#45;&gt;u0</title>
<path fill="none" stroke="black" d="M1167.62,-721.04C1161.48,-718.88 1155.04,-716.66 1149,-714.66 1003.04,-666.32 828.31,-614.02 748.55,-590.45"/>
<polygon fill="black" stroke="black" points="749.43,-587.06 738.85,-587.59 747.45,-593.77 749.43,-587.06"/>
</g>
<!-- u26&#45;&gt;u22 -->
<g id="edge35" class="edge">
<title>u26&#45;&gt;u22</title>
<path fill="none" stroke="black" d="M979.97,-720.89C975.13,-718.64 969.95,-716.43 965,-714.66 892.52,-688.77 871.13,-693.36 797,-672.66 794.25,-671.89 791.42,-671.08 788.58,-670.25"/>
<polygon fill="black" stroke="black" points="789.48,-666.87 778.9,-667.37 787.48,-673.58 789.48,-666.87"/>
</g>
<!-- u27&#45;&gt;u22 -->
<g id="edge36" class="edge">
<title>u27&#45;&gt;u22</title>
<path fill="none" stroke="black" d="M1058.23,-720.39C1051.24,-718.33 1043.92,-716.31 1037,-714.66 931.66,-689.55 902.27,-698.03 797,-672.66 794.04,-671.95 791,-671.16 787.94,-670.33"/>
<polygon fill="black" stroke="black" points="788.79,-666.93 778.21,-667.56 786.87,-673.66 788.79,-666.93"/>
</g>
<!-- u15 -->
<g id="node28" class="node">
<title>u15</title>
<ellipse fill="#ffffbb" stroke="black" stroke-width="2" cx="705" cy="-380.66" rx="30.59" ry="18"/>
<text text-anchor="middle" x="705" y="-376.96" font-family="Times-Roman" font-size="14.00">Utils</text>
</g>
<!-- u28&#45;&gt;u15 -->
<g id="edge37" class="edge">
<title>u28&#45;&gt;u15</title>
<path fill="none" stroke="black" d="M71.46,-714.85C93.67,-667.18 164.47,-531.09 271,-477.66 310.47,-457.87 631.26,-485.14 668,-460.66 685.49,-449.01 694.89,-426.77 699.83,-408.86"/>
<polygon fill="black" stroke="black" points="703.29,-409.46 702.25,-398.92 696.49,-407.8 703.29,-409.46"/>
</g>
<!-- u29&#45;&gt;u22 -->
<g id="edge38" class="edge">
<title>u29&#45;&gt;u22</title>
<path fill="none" stroke="black" d="M449.8,-720.49C456.78,-718.42 464.1,-716.37 471,-714.66 565.92,-691.09 592.14,-696.47 687,-672.66 689.96,-671.92 692.99,-671.11 696.04,-670.26"/>
<polygon fill="black" stroke="black" points="697.13,-673.6 705.77,-667.46 695.19,-666.87 697.13,-673.6"/>
</g>
<!-- u30&#45;&gt;u22 -->
<g id="edge39" class="edge">
<title>u30&#45;&gt;u22</title>
<path fill="none" stroke="black" d="M528.08,-721.03C532.92,-718.78 538.09,-716.52 543,-714.66 605.33,-691.02 623.15,-691.84 687,-672.66 689.74,-671.84 692.55,-670.99 695.38,-670.12"/>
<polygon fill="black" stroke="black" points="696.5,-673.44 705.04,-667.17 694.46,-666.75 696.5,-673.44"/>
</g>
<!-- u31&#45;&gt;u0 -->
<g id="edge40" class="edge">
<title>u31&#45;&gt;u0</title>
<path fill="none" stroke="black" d="M1267.21,-719.95C1204.45,-699.67 1070.24,-657.41 955,-628.66 885.44,-611.3 803.91,-595.51 753.35,-586.24"/>
<polygon fill="black" stroke="black" points="753.82,-582.77 743.35,-584.42 752.56,-589.65 753.82,-582.77"/>
</g>
<!-- u32&#45;&gt;u22 -->
<g id="edge41" class="edge">
<title>u32&#45;&gt;u22</title>
<path fill="none" stroke="black" d="M639.9,-716.28C659.59,-704.59 686.84,-688.41 708.23,-675.71"/>
<polygon fill="black" stroke="black" points="710.2,-678.61 717.01,-670.5 706.62,-672.6 710.2,-678.61"/>
</g>
<!-- u33&#45;&gt;u22 -->
<g id="edge42" class="edge">
<title>u33&#45;&gt;u22</title>
<path fill="none" stroke="black" d="M742,-714.41C742,-705.18 742,-693.59 742,-683.15"/>
<polygon fill="black" stroke="black" points="745.5,-682.84 742,-672.84 738.5,-682.84 745.5,-682.84"/>
</g>
<!-- u34&#45;&gt;u0 -->
<g id="edge43" class="edge">
<title>u34&#45;&gt;u0</title>
<path fill="none" stroke="black" d="M256.18,-721.27C261.01,-719.01 266.15,-716.68 271,-714.66 321.21,-693.69 336.18,-694.54 386,-672.66 424.95,-655.55 430.98,-643.09 471,-628.66 532.58,-606.45 606.93,-592.27 655.04,-584.64"/>
<polygon fill="black" stroke="black" points="655.85,-588.06 665.19,-583.07 654.78,-581.14 655.85,-588.06"/>
</g>
<!-- u35&#45;&gt;u0 -->
<g id="edge44" class="edge">
<title>u35&#45;&gt;u0</title>
<path fill="none" stroke="black" d="M342.11,-720.95C409.78,-694.23 586.34,-624.51 665.55,-593.24"/>
<polygon fill="black" stroke="black" points="667.14,-596.37 675.16,-589.44 664.57,-589.86 667.14,-596.37"/>
</g>
<!-- u14 -->
<g id="node36" class="node">
<title>u14</title>
<ellipse fill="#ffffbb" stroke="black" stroke-width="0" cx="934" cy="-495.66" rx="48.19" ry="18"/>
<text text-anchor="middle" x="934" y="-491.96" font-family="Times-Roman" font-size="14.00">Platform</text>
</g>
<!-- u36&#45;&gt;u14 -->
<g id="edge45" class="edge">
<title>u36&#45;&gt;u14</title>
<path fill="none" stroke="black" d="M1426.01,-716.06C1331.57,-673.94 1071.92,-558.16 972.98,-514.04"/>
<polygon fill="black" stroke="black" points="974.21,-510.76 963.65,-509.88 971.36,-517.15 974.21,-510.76"/>
</g>
<!-- u18 -->
<g id="node37" class="node">
<title>u18</title>
<ellipse fill="#ffffbb" stroke="black" stroke-width="0" cx="1461" cy="-495.66" rx="73.39" ry="18"/>
<text text-anchor="middle" x="1461" y="-491.96" font-family="Times-Roman" font-size="14.00">Requirements</text>
</g>
<!-- u36&#45;&gt;u18 -->
<g id="edge46" class="edge">
<title>u36&#45;&gt;u18</title>
<path fill="none" stroke="black" d="M1461,-714.38C1461,-673.98 1461,-573.06 1461,-524.13"/>
<polygon fill="black" stroke="black" points="1464.5,-523.97 1461,-513.97 1457.5,-523.97 1464.5,-523.97"/>
</g>
<!-- u37&#45;&gt;u0 -->
<g id="edge47" class="edge">
<title>u37&#45;&gt;u0</title>
<path fill="none" stroke="black" d="M178.73,-719.04C219.16,-697.17 306.76,-652.29 386,-628.66 478.02,-601.22 589.65,-587.67 653.49,-581.71"/>
<polygon fill="black" stroke="black" points="654.05,-585.17 663.7,-580.78 653.42,-578.2 654.05,-585.17"/>
</g>
<!-- u3 -->
<g id="node21" class="node">
<title>u3</title>
<ellipse fill="#ffffbb" stroke="black" stroke-width="2" cx="1257" cy="-213.66" rx="36.29" ry="18"/>
<text text-anchor="middle" x="1257" y="-209.96" font-family="Times-Roman" font-size="14.00">Types</text>
</g>
<!-- u4 -->
<g id="node22" class="node">
<title>u4</title>
<ellipse fill="#bbffff" stroke="black" stroke-width="0" cx="1329" cy="-291.66" rx="39.79" ry="18"/>
<text text-anchor="middle" x="1329" y="-287.96" font-family="Times-Roman" font-size="14.00">Optics</text>
</g>
<!-- u4&#45;&gt;u3 -->
<g id="edge48" class="edge">
<title>u4&#45;&gt;u3</title>
<path fill="none" stroke="black" d="M1314.08,-274.91C1303.94,-264.21 1290.37,-249.88 1278.99,-237.88"/>
<polygon fill="black" stroke="black" points="1281.32,-235.24 1271.9,-230.39 1276.24,-240.05 1281.32,-235.24"/>
</g>
<!-- u6 -->
<g id="node29" class="node">
<title>u6</title>
<ellipse fill="#ffbbff" stroke="black" stroke-width="0" cx="934" cy="-380.66" rx="64.19" ry="18"/>
<text text-anchor="middle" x="934" y="-376.96" font-family="Times-Roman" font-size="14.00">MegaParsec</text>
</g>
<!-- u5&#45;&gt;u6 -->
<g id="edge49" class="edge">
<title>u5&#45;&gt;u6</title>
<path fill="none" stroke="black" d="M1226.6,-309.05C1217.94,-320.06 1204.99,-333.77 1190,-340.66 1152.94,-357.69 1046.95,-346.43 1007,-354.66 997.85,-356.55 988.26,-359.26 979.16,-362.21"/>
<polygon fill="black" stroke="black" points="977.86,-358.96 969.51,-365.48 980.11,-365.59 977.86,-358.96"/>
</g>
<!-- u7 -->
<g id="node30" class="node">
<title>u7</title>
<ellipse fill="#ffbbff" stroke="black" stroke-width="0" cx="1030" cy="-213.66" rx="44.39" ry="18"/>
<text text-anchor="middle" x="1030" y="-209.96" font-family="Times-Roman" font-size="14.00">Prelude</text>
</g>
<!-- u5&#45;&gt;u7 -->
<g id="edge50" class="edge">
<title>u5&#45;&gt;u7</title>
<path fill="none" stroke="black" d="M1218.91,-276.55C1213.05,-272.65 1206.44,-268.67 1200,-265.66 1160.61,-247.27 1113.01,-233.67 1078.21,-225.15"/>
<polygon fill="black" stroke="black" points="1078.83,-221.7 1068.29,-222.78 1077.21,-228.51 1078.83,-221.7"/>
</g>
<!-- u9 -->
<g id="node25" class="node">
<title>u9</title>
<ellipse fill="#77ff77" stroke="black" stroke-width="0" cx="803" cy="-291.66" rx="51.19" ry="18"/>
<text text-anchor="middle" x="803" y="-287.96" font-family="Times-Roman" font-size="14.00">Common</text>
</g>
<!-- u12&#45;&gt;u9 -->
<g id="edge59" class="edge">
<title>u12&#45;&gt;u9</title>
<path fill="none" stroke="black" d="M820.65,-362.47C817.58,-350.32 813.4,-333.77 809.87,-319.84"/>
<polygon fill="black" stroke="black" points="813.18,-318.65 807.34,-309.81 806.4,-320.37 813.18,-318.65"/>
</g>
<!-- u9&#45;&gt;u7 -->
<g id="edge60" class="edge">
<title>u9&#45;&gt;u7</title>
<path fill="none" stroke="black" d="M831.8,-276.66C840.15,-272.85 849.35,-268.89 858,-265.66 899.83,-250.04 948.74,-235.92 983.69,-226.52"/>
<polygon fill="black" stroke="black" points="984.85,-229.83 993.61,-223.88 983.05,-223.07 984.85,-229.83"/>
</g>
<!-- u10 -->
<g id="node26" class="node">
<title>u10</title>
<ellipse fill="#ffff77" stroke="black" stroke-width="0" cx="1030" cy="-53.66" rx="27" ry="18"/>
<text text-anchor="middle" x="1030" y="-49.96" font-family="Times-Roman" font-size="14.00">QQ</text>
</g>
<!-- u16 -->
<g id="node27" class="node">
<title>u16</title>
<ellipse fill="#7777ff" stroke="black" stroke-width="0" cx="629" cy="-380.66" rx="27" ry="18"/>
<text text-anchor="middle" x="629" y="-376.96" font-family="Times-Roman" font-size="14.00">QQ</text>
</g>
<!-- u15&#45;&gt;u1 -->
<g id="edge51" class="edge">
<title>u15&#45;&gt;u1</title>
<path fill="none" stroke="black" d="M707.32,-398.87C710.83,-417.56 719.45,-446.6 740,-460.66 773.6,-483.65 1065.83,-471.03 1106,-477.66 1109.69,-478.27 1113.47,-479.03 1117.26,-479.89"/>
<polygon fill="black" stroke="black" points="1116.67,-483.35 1127.21,-482.36 1118.35,-476.55 1116.67,-483.35"/>
</g>
<!-- u6&#45;&gt;u3 -->
<g id="edge52" class="edge">
<title>u6&#45;&gt;u3</title>
<path fill="none" stroke="black" d="M969.52,-365.51C981.28,-361.37 994.54,-357.25 1007,-354.66 1044.76,-346.8 1151.18,-366.3 1180,-340.66 1205.4,-318.06 1177.53,-294.82 1195,-265.66 1202.54,-253.08 1214.35,-242.23 1225.65,-233.81"/>
<polygon fill="black" stroke="black" points="1227.95,-236.47 1234.11,-227.86 1223.92,-230.75 1227.95,-236.47"/>
</g>
<!-- u8 -->
<g id="node31" class="node">
<title>u8</title>
<ellipse fill="#ffbbff" stroke="black" stroke-width="0" cx="1030" cy="-135.66" rx="42.49" ry="18"/>
<text text-anchor="middle" x="1030" y="-131.96" font-family="Times-Roman" font-size="14.00">Logger</text>
</g>
<!-- u7&#45;&gt;u8 -->
<g id="edge54" class="edge">
<title>u7&#45;&gt;u8</title>
<path fill="none" stroke="black" stroke-dasharray="5,2" d="M1030,-195.41C1030,-186.18 1030,-174.59 1030,-164.15"/>
<polygon fill="black" stroke="black" points="1033.5,-163.84 1030,-153.84 1026.5,-163.84 1033.5,-163.84"/>
</g>
<!-- u2 -->
<g id="node34" class="node">
<title>u2</title>
<ellipse fill="#ffffbb" stroke="black" stroke-width="0" cx="1128" cy="-291.66" rx="37.89" ry="18"/>
<text text-anchor="middle" x="1128" y="-287.96" font-family="Times-Roman" font-size="14.00">Errors</text>
</g>
<!-- u7&#45;&gt;u2 -->
<g id="edge53" class="edge">
<title>u7&#45;&gt;u2</title>
<path fill="none" stroke="black" d="M1049.85,-230.05C1064.58,-241.48 1084.85,-257.2 1101.05,-269.76"/>
<polygon fill="black" stroke="black" points="1099.06,-272.64 1109.1,-276.01 1103.35,-267.11 1099.06,-272.64"/>
</g>
<!-- u8&#45;&gt;u4 -->
<g id="edge55" class="edge">
<title>u8&#45;&gt;u4</title>
<path fill="none" stroke="black" d="M1071.74,-139.12C1139.49,-143.98 1269.17,-157.08 1302,-187.66 1322.76,-207 1328.33,-240.18 1329.47,-263.64"/>
<polygon fill="black" stroke="black" points="1325.97,-263.75 1329.71,-273.66 1332.97,-263.58 1325.97,-263.75"/>
</g>
<!-- u8&#45;&gt;u9 -->
<g id="edge56" class="edge">
<title>u8&#45;&gt;u9</title>
<path fill="none" stroke="black" stroke-dasharray="5,2" d="M1008.49,-151.25C968.13,-178.63 880.88,-237.82 834.11,-269.55"/>
<polygon fill="black" stroke="black" points="831.91,-266.82 825.6,-275.33 835.84,-272.61 831.91,-266.82"/>
</g>
<!-- u8&#45;&gt;u10 -->
<g id="edge57" class="edge">
<title>u8&#45;&gt;u10</title>
<path fill="none" stroke="black" d="M1030,-117.3C1030,-106.96 1030,-93.6 1030,-81.88"/>
<polygon fill="black" stroke="black" points="1033.5,-81.71 1030,-71.71 1026.5,-81.71 1033.5,-81.71"/>
</g>
<!-- u11&#45;&gt;u5 -->
<g id="edge58" class="edge">
<title>u11&#45;&gt;u5</title>
<path fill="none" stroke="black" d="M1060.4,-365.35C1065.63,-361.25 1071.74,-357.21 1078,-354.66 1124.47,-335.76 1144.94,-362.7 1190,-340.66 1201.46,-335.05 1211.82,-325.6 1219.95,-316.56"/>
<polygon fill="black" stroke="black" points="1222.7,-318.72 1226.49,-308.83 1217.36,-314.2 1222.7,-318.72"/>
</g>
<!-- u0&#45;&gt;u16 -->
<g id="edge4" class="edge">
<title>u0&#45;&gt;u16</title>
<path fill="none" stroke="black" d="M698.39,-558.78C685.1,-524.87 655.09,-448.27 639.25,-407.82"/>
<polygon fill="black" stroke="black" points="642.45,-406.39 635.54,-398.36 635.93,-408.95 642.45,-406.39"/>
</g>
<!-- u0&#45;&gt;u15 -->
<g id="edge3" class="edge">
<title>u0&#45;&gt;u15</title>
<path fill="none" stroke="black" d="M705,-558.44C705,-524.72 705,-449.72 705,-409.09"/>
<polygon fill="black" stroke="black" points="708.5,-408.84 705,-398.84 701.5,-408.84 708.5,-408.84"/>
</g>
<!-- u0&#45;&gt;u14 -->
<g id="edge2" class="edge">
<title>u0&#45;&gt;u14</title>
<path fill="none" stroke="black" d="M736.84,-564.68C776.8,-550.89 845.52,-527.18 890.35,-511.72"/>
<polygon fill="black" stroke="black" points="891.51,-515.02 899.82,-508.45 889.22,-508.4 891.51,-515.02"/>
</g>
<!-- u2&#45;&gt;u3 -->
<g id="edge5" class="edge">
<title>u2&#45;&gt;u3</title>
<path fill="none" stroke="black" d="M1150.77,-277.25C1171.58,-264.98 1202.56,-246.73 1225.7,-233.1"/>
<polygon fill="black" stroke="black" points="1227.62,-236.03 1234.46,-227.94 1224.07,-230 1227.62,-236.03"/>
</g>
<!-- u13&#45;&gt;u3 -->
<g id="edge6" class="edge">
<title>u13&#45;&gt;u3</title>
<path fill="none" stroke="black" d="M1412.98,-362.38C1410.65,-337.92 1403.02,-293.12 1378,-265.66 1357.81,-243.49 1326.42,-230.64 1300.67,-223.38"/>
<polygon fill="black" stroke="black" points="1301.32,-219.94 1290.76,-220.78 1299.54,-226.71 1301.32,-219.94"/>
</g>
<!-- u14&#45;&gt;u5 -->
<g id="edge7" class="edge">
<title>u14&#45;&gt;u5</title>
<path fill="none" stroke="black" d="M980.15,-490.19C1019.57,-485.37 1072.04,-476.2 1086,-460.66 1117.68,-425.38 1065.12,-388.82 1098,-354.66 1126.68,-324.86 1153.09,-359.32 1190,-340.66 1201.39,-334.9 1211.73,-325.43 1219.87,-316.41"/>
<polygon fill="black" stroke="black" points="1222.61,-318.59 1226.43,-308.71 1217.28,-314.05 1222.61,-318.59"/>
</g>
<!-- u14&#45;&gt;u12 -->
<g id="edge8" class="edge">
<title>u14&#45;&gt;u12</title>
<path fill="none" stroke="black" d="M895.43,-484.64C881.53,-479.41 866.66,-471.72 856,-460.66 842.29,-446.43 834.43,-425.42 830.06,-408.64"/>
<polygon fill="black" stroke="black" points="833.46,-407.78 827.77,-398.84 826.64,-409.37 833.46,-407.78"/>
</g>
<!-- u18&#45;&gt;u5 -->
<g id="edge10" class="edge">
<title>u18&#45;&gt;u5</title>
<path fill="none" stroke="black" d="M1468.63,-477.37C1480.29,-447.97 1498.11,-388.19 1467,-354.66 1438.65,-324.11 1317.28,-359.28 1280,-340.66 1269.49,-335.41 1260.48,-326.27 1253.53,-317.36"/>
<polygon fill="black" stroke="black" points="1256.2,-315.09 1247.51,-309.03 1250.53,-319.18 1256.2,-315.09"/>
</g>
<!-- u18&#45;&gt;u13 -->
<g id="edge9" class="edge">
<title>u18&#45;&gt;u13</title>
<path fill="none" stroke="black" d="M1453.86,-477.5C1446.19,-459.06 1433.9,-429.51 1425,-408.1"/>
<polygon fill="black" stroke="black" points="1428.12,-406.5 1421.05,-398.61 1421.66,-409.19 1428.12,-406.5"/>
</g>
<!-- u20 -->
<g id="node38" class="node">
<title>u20</title>
<ellipse fill="#bbffbb" stroke="black" stroke-width="0" cx="742" cy="-925.66" rx="32.49" ry="18"/>
<text text-anchor="middle" x="742" y="-921.96" font-family="Times-Roman" font-size="14.00">Main</text>
</g>
<!-- u20&#45;&gt;u21 -->
<g id="edge1" class="edge">
<title>u20&#45;&gt;u21</title>
<path fill="none" stroke="black" d="M840.39,-669.7C840.39,-661.98 840.39,-652.71 840.39,-644.11"/>
<polygon fill="black" stroke="black" points="843.89,-644.1 840.39,-634.1 836.89,-644.1 843.89,-644.1"/>
</g>
<!-- u21&#45;&gt;u0 -->
<g id="edge2" class="edge">
<title>u21&#45;&gt;u0</title>
<path fill="none" stroke="black" d="M840.39,-597.7C840.39,-589.25 840.39,-578.87 840.39,-569.37"/>
<polygon fill="black" stroke="black" points="843.89,-569.18 840.39,-559.18 836.89,-569.18 843.89,-569.18"/>
<path fill="none" stroke="black" d="M742,-907.5C742,-889.33 742,-860.38 742,-839.05"/>
<polygon fill="black" stroke="black" points="745.5,-838.98 742,-828.98 738.5,-838.98 745.5,-838.98"/>
</g>
</g>
</svg>

Before

Width:  |  Height:  |  Size: 19 KiB

After

Width:  |  Height:  |  Size: 33 KiB

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
@@ -16,11 +16,8 @@ description:
category: System
build-type: Simple
extra-doc-files:
data/config.yaml
data/metadata/ghcup-0.0.4.yaml
data/metadata/ghcup-0.0.5.yaml
data/metadata/ghcup-0.0.6.yaml
CHANGELOG.md
data/config.yaml
README.md
extra-source-files:
@@ -46,6 +43,11 @@ flag internal-downloader
default: False
manual: True
flag no-exe
description: Don't build any executables
default: False
manual: True
library
exposed-modules:
GHCup
@@ -92,7 +94,7 @@ library
-fwarn-incomplete-record-updates
build-depends:
, aeson >=1.4 && <1.6
, aeson >=1.4
, async >=0.8 && <2.3
, base >=4.13 && <5
, base16-bytestring >=0.1.1.6 && <1.1
@@ -109,7 +111,6 @@ library
, filepath ^>=1.4.2.1
, haskus-utils-types ^>=1.5
, haskus-utils-variant >=3.0 && <3.2
, HsYAML-aeson ^>=0.2.0.0
, libarchive ^>=3.0.3.0
, lzma-static ^>=5.2.5.3
, megaparsec >=8.0.0 && <9.1
@@ -120,6 +121,7 @@ library
, pretty-terminal ^>=0.1.0.0
, regex-posix ^>=0.96
, resourcet ^>=1.2.2
, retry ^>=0.8.1.2
, safe ^>=0.3.18
, safe-exceptions ^>=0.1
, split ^>=0.2.3.4
@@ -135,6 +137,7 @@ library
, vector ^>=0.12
, versions >=4.0.1 && <5.1
, word8 ^>=0.1.3
, yaml-streamly ^>=0.12.0
, zlib ^>=0.6.2.2
if (flag(internal-downloader) && !os(windows))
@@ -148,16 +151,21 @@ library
if os(windows)
cpp-options: -DIS_WINDOWS
other-modules: GHCup.Utils.File.Windows
other-modules:
GHCup.Utils.File.Windows
GHCup.Utils.Prelude.Windows
GHCup.Utils.Windows
build-depends:
, bzlib
, process ^>=1.6.11.0
, retry ^>=0.8.1.2
, Win32 ^>=2.10
else
other-modules:
GHCup.Utils.File.Posix
GHCup.Utils.Posix
GHCup.Utils.Prelude.Posix
System.Console.Terminal.Common
System.Console.Terminal.Posix
@@ -172,6 +180,25 @@ library
executable ghcup
main-is: Main.hs
other-modules:
GHCup.OptParse
GHCup.OptParse.ChangeLog
GHCup.OptParse.Common
GHCup.OptParse.Compile
GHCup.OptParse.Config
GHCup.OptParse.DInfo
GHCup.OptParse.GC
GHCup.OptParse.Install
GHCup.OptParse.List
GHCup.OptParse.Nuke
GHCup.OptParse.Prefetch
GHCup.OptParse.Rm
GHCup.OptParse.Set
GHCup.OptParse.ToolRequirements
GHCup.OptParse.UnSet
GHCup.OptParse.Upgrade
GHCup.OptParse.Whereis
hs-source-dirs: app/ghcup
default-language: Haskell2010
default-extensions:
@@ -189,7 +216,7 @@ executable ghcup
-fwarn-incomplete-record-updates -threaded
build-depends:
, aeson >=1.4 && <1.6
, aeson >=1.4
, aeson-pretty ^>=0.8.8
, async ^>=2.2.3
, base >=4.13 && <5
@@ -197,10 +224,10 @@ executable ghcup
, 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
, HsYAML-aeson ^>=0.2.0.0
, libarchive ^>=3.0.3.0
, megaparsec >=8.0.0 && <9.1
, mtl ^>=2.2
@@ -215,6 +242,7 @@ executable ghcup
, uri-bytestring ^>=0.3.2.2
, utf8-string ^>=1.0
, versions >=4.0.1 && <5.1
, yaml-streamly ^>=0.12.0
if flag(internal-downloader)
cpp-options: -DINTERNAL_DOWNLOADER
@@ -225,56 +253,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
, HsYAML-aeson ^>=0.2.0.0
, 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
if flag(no-exe)
buildable: False
test-suite ghcup-test
type: exitcode-stdio-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

View File

@@ -52,9 +52,7 @@ import Control.Monad.Fail ( MonadFail )
import Control.Monad.Reader
import Control.Monad.Trans.Resource
hiding ( throwM )
#if defined(IS_WINDOWS)
import Control.Monad.IO.Unlift ( MonadUnliftIO( withRunInIO ) )
#endif
import Data.ByteString ( ByteString )
import Data.Either
import Data.List
@@ -96,9 +94,6 @@ import qualified Data.Map.Strict as Map
import qualified Data.Text as T
import qualified Data.Text.IO as T
import qualified Data.Text.Encoding as E
#if defined(IS_WINDOWS)
import qualified System.Win32.File as Win32
#endif
import qualified Text.Megaparsec as MP
import GHCup.Utils.MegaParsec
import Control.Concurrent (threadDelay)
@@ -339,36 +334,35 @@ installUnpackedGHC :: ( MonadReader env m
-> FilePath -- ^ Path to install to
-> Version -- ^ The GHC version
-> Excepts '[ProcessError] m ()
installUnpackedGHC path inst ver = do
#if defined(IS_WINDOWS)
lift $ logInfo "Installing GHC (this may take a while)"
-- Windows bindists are relocatable and don't need
-- to run configure.
-- We also must make sure to preserve mtime to not confuse ghc-pkg.
lift $ withRunInIO $ \run -> flip onException (run $ recyclePathForcibly inst) $ copyDirectoryRecursive path inst $ \source dest -> do
mtime <- getModificationTime source
Win32.moveFile source dest
setModificationTime dest mtime
#else
PlatformRequest {..} <- lift getPlatformReq
installUnpackedGHC path inst ver
| isWindows = do
lift $ logInfo "Installing GHC (this may take a while)"
-- Windows bindists are relocatable and don't need
-- to run configure.
-- We also must make sure to preserve mtime to not confuse ghc-pkg.
lift $ withRunInIO $ \run -> flip onException (run $ recyclePathForcibly inst) $ copyDirectoryRecursive path inst $ \source dest -> do
mtime <- getModificationTime source
moveFilePortable source dest
setModificationTime dest mtime
| otherwise = do
PlatformRequest {..} <- lift getPlatformReq
let alpineArgs
| ver >= [vver|8.2.2|], Linux Alpine <- _rPlatform
= ["--disable-ld-override"]
| otherwise
= []
let alpineArgs
| ver >= [vver|8.2.2|], Linux Alpine <- _rPlatform
= ["--disable-ld-override"]
| otherwise
= []
lift $ logInfo "Installing GHC (this may take a while)"
lEM $ execLogged "sh"
("./configure" : ("--prefix=" <> inst)
: alpineArgs
)
(Just path)
"ghc-configure"
Nothing
lEM $ make ["install"] (Just path)
pure ()
#endif
lift $ logInfo "Installing GHC (this may take a while)"
lEM $ execLogged "sh"
("./configure" : ("--prefix=" <> inst)
: alpineArgs
)
(Just path)
"ghc-configure"
Nothing
lEM $ make ["install"] (Just path)
pure ()
-- | Installs GHC into @~\/.ghcup\/ghc/\<ver\>@ and places the
@@ -1147,15 +1141,17 @@ setGHC ver sghc = do
logDebug $ "rm -f " <> T.pack fullF
hideError doesNotExistErrorType $ rmDirectoryLink fullF
logDebug $ "ln -s " <> T.pack targetF <> " " <> T.pack fullF
liftIO
#if defined(IS_WINDOWS)
-- On windows we need to be more permissive
-- in case symlinks can't be created, be just
-- give up here. This symlink isn't strictly necessary.
$ hideError permissionErrorType
$ hideError illegalOperationErrorType
#endif
$ createDirectoryLink targetF fullF
if isWindows
then liftIO
-- On windows we need to be more permissive
-- in case symlinks can't be created, be just
-- give up here. This symlink isn't strictly necessary.
$ hideError permissionErrorType
$ hideError illegalOperationErrorType
$ createDirectoryLink targetF fullF
else liftIO
$ createDirectoryLink targetF fullF
_ -> pure ()
unsetGHC :: ( MonadReader env m
@@ -1578,7 +1574,7 @@ listVersions lt' criteria = do
currentGHCup :: Map.Map Version VersionInfo -> Maybe ListResult
currentGHCup av =
let currentVer = fromJust $ pvpToVersion ghcUpVer
let currentVer = fromJust $ pvpToVersion ghcUpVer ""
listVer = Map.lookup currentVer av
latestVer = fst <$> headOf (getTagged Latest) av
recommendedVer = fst <$> headOf (getTagged Latest) av
@@ -1876,17 +1872,17 @@ rmGhcup = do
unless areEqualPaths $ logWarn $ nonStandardInstallLocationMsg currentRunningExecPath
#if defined(IS_WINDOWS)
-- since it doesn't seem possible to delete a running exe on windows
-- we move it to temp dir, to be deleted at next reboot
tempFilepath <- mkGhcupTmpDir
hideError UnsupportedOperation $
liftIO $ hideError NoSuchThing $
Win32.moveFileEx ghcupFilepath (Just (tempFilepath </> "ghcup")) 0
#else
-- delete it.
hideError doesNotExistErrorType $ rmFile ghcupFilepath
#endif
if isWindows
then do
-- since it doesn't seem possible to delete a running exe on windows
-- we move it to temp dir, to be deleted at next reboot
tempFilepath <- mkGhcupTmpDir
hideError UnsupportedOperation $
liftIO $ hideError NoSuchThing $
moveFile ghcupFilepath (tempFilepath </> "ghcup")
else
-- delete it.
hideError doesNotExistErrorType $ rmFile ghcupFilepath
where
handlePathNotPresent fp _err = do
@@ -1946,10 +1942,9 @@ rmGhcupDirs = do
handleRm $ rmBinDir binDir
handleRm $ rmDir recycleDir
#if defined(IS_WINDOWS)
logInfo $ "removing " <> T.pack (baseDir </> "msys64")
handleRm $ rmPathForcibly (baseDir </> "msys64")
#endif
when isWindows $ do
logInfo $ "removing " <> T.pack (baseDir </> "msys64")
handleRm $ rmPathForcibly (baseDir </> "msys64")
handleRm $ removeEmptyDirsRecursive baseDir
@@ -1983,15 +1978,13 @@ rmGhcupDirs = do
forM_ contents (deleteFile . (dir </>))
rmBinDir :: (MonadReader env m, HasDirs env, MonadMask m, MonadIO m, MonadCatch m) => FilePath -> m ()
rmBinDir binDir = do
#if !defined(IS_WINDOWS)
isXDGStyle <- liftIO useXDG
if not isXDGStyle
then removeDirIfEmptyOrIsSymlink binDir
else pure ()
#else
removeDirIfEmptyOrIsSymlink binDir
#endif
rmBinDir binDir
| isWindows = removeDirIfEmptyOrIsSymlink binDir
| otherwise = do
isXDGStyle <- liftIO useXDG
if not isXDGStyle
then removeDirIfEmptyOrIsSymlink binDir
else pure ()
reportRemainingFiles :: MonadIO m => FilePath -> m [FilePath]
reportRemainingFiles dir = do
@@ -2311,11 +2304,9 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patchdir aargs buildFlavour had
m
FilePath
findHadrianFile workdir = do
#if defined(IS_WINDOWS)
let possible_files = ((workdir </> "hadrian") </>) <$> ["build.bat"]
#else
let possible_files = ((workdir </> "hadrian") </>) <$> ["build", "build.sh"]
#endif
let possible_files = if isWindows
then ((workdir </> "hadrian") </>) <$> ["build.bat"]
else ((workdir </> "hadrian") </>) <$> ["build", "build.sh"]
exsists <- forM possible_files (\f -> liftIO (doesFileExist f) <&> (,f))
case filter fst exsists of
[] -> throwE HadrianNotFound
@@ -2489,9 +2480,7 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patchdir aargs buildFlavour had
(\x -> ["--target=" <> T.unpack x])
(_tvTarget tver)
++ ["--prefix=" <> ghcdir]
#if defined(IS_WINDOWS)
++ ["--enable-tarballs-autodownload"]
#endif
++ (if isWindows then ["--enable-tarballs-autodownload"] else [])
++ fmap T.unpack aargs
)
(Just workdir)
@@ -2505,9 +2494,7 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patchdir aargs buildFlavour had
(\x -> ["--target=" <> T.unpack x])
(_tvTarget tver)
++ ["--prefix=" <> ghcdir]
#if defined(IS_WINDOWS)
++ ["--enable-tarballs-autodownload"]
#endif
++ (if isWindows then ["--enable-tarballs-autodownload"] else [])
++ fmap T.unpack aargs
)
(Just workdir)
@@ -2589,7 +2576,7 @@ upgradeGHCup mtarget force' = do
lift $ logInfo "Upgrading GHCup..."
let latestVer = fromJust $ fst <$> getLatest dls GHCup
(Just ghcupPVPVer) <- pure $ pvpToVersion ghcUpVer
(Just ghcupPVPVer) <- pure $ pvpToVersion ghcUpVer ""
when (not force' && (latestVer <= ghcupPVPVer)) $ throwE NoUpdate
dli <- liftE $ getDownloadInfo GHCup latestVer
tmp <- lift withGHCupTmpDir

View File

@@ -49,7 +49,6 @@ import Control.Monad.Reader
import Control.Monad.Trans.Resource
hiding ( throwM )
import Data.Aeson
import Data.Bifunctor
import Data.ByteString ( ByteString )
#if defined(INTERNAL_DOWNLOADER)
import Data.CaseInsensitive ( mk )
@@ -87,7 +86,7 @@ import qualified Data.Map.Strict as M
import qualified Data.Text as T
import qualified Data.Text.IO as T
import qualified Data.Text.Encoding as E
import qualified Data.YAML.Aeson as Y
import qualified Data.Yaml.Aeson as Y
@@ -183,15 +182,14 @@ getBase uri = do
-- if we didn't get a filepath from the download, use the cached yaml
actualYaml <- maybe (lift $ yamlFromCache uri) pure mYaml
yamlContents <- liftIOException doesNotExistErrorType (FileDoesNotExistError actualYaml) $ liftIO $ L.readFile actualYaml
lift $ logDebug $ "Decoding yaml at: " <> T.pack actualYaml
liftE
. onE_ (onError actualYaml)
. lE' @_ @_ @'[JSONError] JSONDecodeError
. first (\(_, e) -> unlines [e, "Consider removing " <> actualYaml <> " manually."])
. Y.decode1
$ yamlContents
. lEM' @_ @_ @'[JSONError] (\(displayException -> e) -> JSONDecodeError $ unlines [e, "Consider removing " <> actualYaml <> " manually."])
. liftIO
. Y.decodeFileEither
$ actualYaml
where
-- On error, remove the etags file and set access time to 0. This should ensure the next invocation
-- may re-download and succeed.
@@ -244,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

@@ -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

@@ -28,9 +28,9 @@ import GHCup.Utils.Logger () -- TH is broken shite and nee
-- This is due to the boot file.
import Control.Applicative ( (<|>) )
import Data.Aeson
import Data.Aeson hiding (Key)
import Data.Aeson.TH
import Data.Aeson.Types
import Data.Aeson.Types hiding (Key)
import Data.List.NonEmpty ( NonEmpty(..) )
import Data.Text.Encoding as E
import Data.Versions

View File

@@ -22,13 +22,21 @@ installation and introspection of files/versions etc.
module GHCup.Utils
( module GHCup.Utils.Dirs
, module GHCup.Utils
#if defined(IS_WINDOWS)
, module GHCup.Utils.Windows
#else
, module GHCup.Utils.Posix
#endif
)
where
#if defined(IS_WINDOWS)
import GHCup.Download
import GHCup.Utils.Windows
#else
import GHCup.Utils.Posix
#endif
import GHCup.Download
import GHCup.Errors
import GHCup.Types
import GHCup.Types.Optics
@@ -51,9 +59,7 @@ import Control.Monad.Reader
import Control.Monad.Trans.Resource
hiding ( throwM )
import Control.Monad.IO.Unlift ( MonadUnliftIO( withRunInIO ) )
#if defined(IS_WINDOWS)
import Data.Bits
#endif
import Data.Bifunctor ( first )
import Data.ByteString ( ByteString )
import Data.Either
import Data.Foldable
@@ -69,11 +75,6 @@ import Safe
import System.Directory hiding ( findFiles )
import System.FilePath
import System.IO.Error
#if defined(IS_WINDOWS)
import System.Win32.Console
import System.Win32.File hiding ( copyFile )
import System.Win32.Types
#endif
import Text.Regex.Posix
import URI.ByteString
@@ -110,8 +111,8 @@ import qualified Data.List.NonEmpty as NE
-- >>> 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)
@@ -631,34 +632,34 @@ 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)
(pvp_, rest) <- versionToPVP _tvVersion
pure (pvp_, rest, _tvTarget)
getGHCForPVP' pvpIn ghcs' mt
-- | Like 'getGHCForPVP', except with explicit input parameter.
--
-- >>> fmap prettyShow $ getGHCForPVP' [pver|8|] installedVersions Nothing
-- "Just 8.10.7"
-- >>> getGHCForPVP' [pver|8|] installedVersions Nothing
-- Just (GHCTargetVersion {_tvTarget = Nothing, _tvVersion = Version {_vEpoch = Nothing, _vChunks = (Digits 8 :| []) :| [Digits 10 :| [],Digits 7 :| []], _vRel = [Str "debug" :| []], _vMeta = Just "lol"}})
-- >>> 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
-> [(PVP, Text, 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)
. sortBy (\(x, _, _) (y, _, _) -> compare x y)
. filter
(\(pvp_, target) ->
(\(pvp_, _, target) ->
target == mt && matchPVPrefix pvp_ pvpIn
)
$ ghcs'
forM mResult $ \(pvp_, target) -> do
ver' <- pvpToVersion pvp_
forM mResult $ \(pvp_, rest, target) -> do
ver' <- pvpToVersion pvp_ rest
pure (GHCTargetVersion target ver')
@@ -679,7 +680,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
@@ -1000,50 +1001,17 @@ getVersionInfo v' tool =
-- | The file extension for executables.
exeExt :: String
#if defined(IS_WINDOWS)
exeExt = ".exe"
#else
exeExt = ""
#endif
exeExt
| isWindows = ".exe"
| otherwise = ""
-- | The file extension for executables.
exeExt' :: ByteString
#if defined(IS_WINDOWS)
exeExt' = ".exe"
#else
exeExt' = ""
#endif
exeExt'
| isWindows = ".exe"
| otherwise = ""
-- | Enables ANSI support on windows, does nothing on unix.
--
-- Returns 'Left str' on errors and 'Right bool' on success, where
-- 'bool' markes whether ansi support was already enabled.
--
-- This function never crashes.
--
-- Rip-off of https://docs.rs/ansi_term/0.12.1/x86_64-pc-windows-msvc/src/ansi_term/windows.rs.html#10-61
enableAnsiSupport :: IO (Either String Bool)
#if defined(IS_WINDOWS)
enableAnsiSupport = handleIO (pure . Left . displayException) $ do
-- ref: https://docs.microsoft.com/en-us/windows/win32/api/fileapi/nf-fileapi-createfilew
-- Using `CreateFileW("CONOUT$", ...)` to retrieve the console handle works correctly even if STDOUT and/or STDERR are redirected
h <- createFile "CONOUT$" (gENERIC_WRITE .|. gENERIC_READ)
fILE_SHARE_WRITE Nothing oPEN_EXISTING 0 Nothing
when (h == iNVALID_HANDLE_VALUE ) $ fail "invalid handle value"
-- ref: https://docs.microsoft.com/en-us/windows/console/getconsolemode
m <- getConsoleMode h
-- VT processing not already enabled?
if ((m .&. eNABLE_VIRTUAL_TERMINAL_PROCESSING) == 0)
-- https://docs.microsoft.com/en-us/windows/console/setconsolemode
then setConsoleMode h (m .|. eNABLE_VIRTUAL_TERMINAL_PROCESSING)
>> pure (Right False)
else pure (Right True)
#else
enableAnsiSupport = pure (Right True)
#endif
-- | On unix, we can use symlinks, so we just get the
@@ -1052,33 +1020,27 @@ enableAnsiSupport = pure (Right True)
-- On windows, we have to emulate symlinks via shims,
-- see 'createLink'.
getLinkTarget :: FilePath -> IO FilePath
getLinkTarget fp = do
#if defined(IS_WINDOWS)
content <- readFile (dropExtension fp <.> "shim")
[p] <- pure . filter ("path = " `isPrefixOf`) . lines $ content
pure $ stripNewline $ dropPrefix "path = " p
#else
getSymbolicLinkTarget fp
#endif
getLinkTarget fp
| isWindows = do
content <- readFile (dropExtension fp <.> "shim")
[p] <- pure . filter ("path = " `isPrefixOf`) . lines $ content
pure $ stripNewline $ dropPrefix "path = " p
| otherwise = getSymbolicLinkTarget fp
-- | Checks whether the path is a link.
pathIsLink :: FilePath -> IO Bool
#if defined(IS_WINDOWS)
pathIsLink fp = doesPathExist (dropExtension fp <.> "shim")
#else
pathIsLink = pathIsSymbolicLink
#endif
pathIsLink fp
| isWindows = doesPathExist (dropExtension fp <.> "shim")
| otherwise = pathIsSymbolicLink fp
rmLink :: (MonadReader env m, HasDirs env, MonadIO m, MonadMask m) => FilePath -> m ()
#if defined(IS_WINDOWS)
rmLink fp = do
hideError doesNotExistErrorType . recycleFile $ fp
hideError doesNotExistErrorType . recycleFile $ (dropExtension fp <.> "shim")
#else
rmLink = hideError doesNotExistErrorType . recycleFile
#endif
rmLink fp
| isWindows = do
hideError doesNotExistErrorType . recycleFile $ fp
hideError doesNotExistErrorType . recycleFile $ (dropExtension fp <.> "shim")
| otherwise = hideError doesNotExistErrorType . recycleFile $ fp
-- | Creates a symbolic link on unix and a fake symlink on windows for
@@ -1102,31 +1064,30 @@ createLink :: ( MonadMask m
=> FilePath -- ^ path to the target executable
-> FilePath -- ^ path to be created
-> m ()
createLink link exe = do
#if defined(IS_WINDOWS)
dirs <- getDirs
let shimGen = cacheDir dirs </> "gs.exe"
createLink link exe
| isWindows = do
dirs <- getDirs
let shimGen = cacheDir dirs </> "gs.exe"
let shim = dropExtension exe <.> "shim"
-- For hardlinks, link needs to be absolute.
-- If link is relative, it's relative to the target exe.
-- Note that (</>) drops lhs when rhs is absolute.
fullLink = takeDirectory exe </> link
shimContents = "path = " <> fullLink
let shim = dropExtension exe <.> "shim"
-- For hardlinks, link needs to be absolute.
-- If link is relative, it's relative to the target exe.
-- Note that (</>) drops lhs when rhs is absolute.
fullLink = takeDirectory exe </> link
shimContents = "path = " <> fullLink
logDebug $ "rm -f " <> T.pack exe
rmLink exe
logDebug $ "rm -f " <> T.pack exe
rmLink exe
logDebug $ "ln -s " <> T.pack fullLink <> " " <> T.pack exe
liftIO $ copyFile shimGen exe
liftIO $ writeFile shim shimContents
#else
logDebug $ "rm -f " <> T.pack exe
hideError doesNotExistErrorType $ recycleFile exe
logDebug $ "ln -s " <> T.pack fullLink <> " " <> T.pack exe
liftIO $ copyFile shimGen exe
liftIO $ writeFile shim shimContents
| otherwise = do
logDebug $ "rm -f " <> T.pack exe
hideError doesNotExistErrorType $ recycleFile exe
logDebug $ "ln -s " <> T.pack link <> " " <> T.pack exe
liftIO $ createFileLink link exe
#endif
logDebug $ "ln -s " <> T.pack link <> " " <> T.pack exe
liftIO $ createFileLink link exe
ensureGlobalTools :: ( MonadMask m
@@ -1141,23 +1102,20 @@ ensureGlobalTools :: ( MonadMask m
, MonadFail m
)
=> Excepts '[GPGError, DigestError , DownloadFailed, NoDownload] m ()
ensureGlobalTools = do
#if defined(IS_WINDOWS)
(GHCupInfo _ _ gTools) <- lift getGHCupInfo
dirs <- lift getDirs
shimDownload <- liftE $ lE @_ @'[NoDownload]
$ maybe (Left NoDownload) Right $ Map.lookup ShimGen gTools
let dl = downloadCached' shimDownload (Just "gs.exe") Nothing
void $ (\(DigestError _ _ _) -> do
lift $ logWarn "Digest doesn't match, redownloading gs.exe..."
lift $ logDebug ("rm -f " <> T.pack (cacheDir dirs </> "gs.exe"))
lift $ hideError doesNotExistErrorType $ recycleFile (cacheDir dirs </> "gs.exe")
liftE @'[GPGError, DigestError , DownloadFailed] $ dl
) `catchE` (liftE @'[GPGError, DigestError , DownloadFailed] dl)
pure ()
#else
pure ()
#endif
ensureGlobalTools
| isWindows = do
(GHCupInfo _ _ gTools) <- lift getGHCupInfo
dirs <- lift getDirs
shimDownload <- liftE $ lE @_ @'[NoDownload]
$ maybe (Left NoDownload) Right $ Map.lookup ShimGen gTools
let dl = downloadCached' shimDownload (Just "gs.exe") Nothing
void $ (\DigestError{} -> do
lift $ logWarn "Digest doesn't match, redownloading gs.exe..."
lift $ logDebug ("rm -f " <> T.pack (cacheDir dirs </> "gs.exe"))
lift $ hideError doesNotExistErrorType $ recycleFile (cacheDir dirs </> "gs.exe")
liftE @'[GPGError, DigestError , DownloadFailed] $ dl
) `catchE` liftE @'[GPGError, DigestError , DownloadFailed] dl
| otherwise = pure ()
-- | Ensure ghcup directory structure exists.

View File

@@ -25,9 +25,7 @@ module GHCup.Utils.Dirs
, relativeSymlink
, withGHCupTmpDir
, getConfigFilePath
#if !defined(IS_WINDOWS)
, useXDG
#endif
, cleanupTrash
)
where
@@ -59,7 +57,7 @@ import System.IO.Temp
import qualified Data.ByteString as BS
import qualified Data.Text as T
import qualified Data.YAML.Aeson as Y
import qualified Data.Yaml.Aeson as Y
import qualified Text.Megaparsec as MP
import Control.Concurrent (threadDelay)
@@ -75,26 +73,25 @@ import Control.Concurrent (threadDelay)
-- If 'GHCUP_USE_XDG_DIRS' is set (to anything),
-- then uses 'XDG_DATA_HOME/ghcup' as per xdg spec.
ghcupBaseDir :: IO FilePath
ghcupBaseDir = do
#if defined(IS_WINDOWS)
bdir <- fromMaybe "C:\\" <$> lookupEnv "GHCUP_INSTALL_BASE_PREFIX"
pure (bdir </> "ghcup")
#else
xdg <- useXDG
if xdg
then do
bdir <- lookupEnv "XDG_DATA_HOME" >>= \case
Just r -> pure r
Nothing -> do
home <- liftIO getHomeDirectory
pure (home </> ".local" </> "share")
ghcupBaseDir
| isWindows = do
bdir <- fromMaybe "C:\\" <$> lookupEnv "GHCUP_INSTALL_BASE_PREFIX"
pure (bdir </> "ghcup")
else do
bdir <- lookupEnv "GHCUP_INSTALL_BASE_PREFIX" >>= \case
Just r -> pure r
Nothing -> liftIO getHomeDirectory
pure (bdir </> ".ghcup")
#endif
| otherwise = do
xdg <- useXDG
if xdg
then do
bdir <- lookupEnv "XDG_DATA_HOME" >>= \case
Just r -> pure r
Nothing -> do
home <- liftIO getHomeDirectory
pure (home </> ".local" </> "share")
pure (bdir </> "ghcup")
else do
bdir <- lookupEnv "GHCUP_INSTALL_BASE_PREFIX" >>= \case
Just r -> pure r
Nothing -> liftIO getHomeDirectory
pure (bdir </> ".ghcup")
-- | ~/.ghcup by default
@@ -102,45 +99,41 @@ ghcupBaseDir = do
-- If 'GHCUP_USE_XDG_DIRS' is set (to anything),
-- then uses 'XDG_CONFIG_HOME/ghcup' as per xdg spec.
ghcupConfigDir :: IO FilePath
ghcupConfigDir = do
#if defined(IS_WINDOWS)
ghcupBaseDir
#else
xdg <- useXDG
if xdg
then do
bdir <- lookupEnv "XDG_CONFIG_HOME" >>= \case
Just r -> pure r
Nothing -> do
home <- liftIO getHomeDirectory
pure (home </> ".config")
pure (bdir </> "ghcup")
else do
bdir <- lookupEnv "GHCUP_INSTALL_BASE_PREFIX" >>= \case
Just r -> pure r
Nothing -> liftIO getHomeDirectory
pure (bdir </> ".ghcup")
#endif
ghcupConfigDir
| isWindows = ghcupBaseDir
| otherwise = do
xdg <- useXDG
if xdg
then do
bdir <- lookupEnv "XDG_CONFIG_HOME" >>= \case
Just r -> pure r
Nothing -> do
home <- liftIO getHomeDirectory
pure (home </> ".config")
pure (bdir </> "ghcup")
else do
bdir <- lookupEnv "GHCUP_INSTALL_BASE_PREFIX" >>= \case
Just r -> pure r
Nothing -> liftIO getHomeDirectory
pure (bdir </> ".ghcup")
-- | If 'GHCUP_USE_XDG_DIRS' is set (to anything),
-- then uses 'XDG_BIN_HOME' env var or defaults to '~/.local/bin'
-- (which, sadly is not strictly xdg spec).
ghcupBinDir :: IO FilePath
ghcupBinDir = do
#if defined(IS_WINDOWS)
ghcupBaseDir <&> (</> "bin")
#else
xdg <- useXDG
if xdg
then do
lookupEnv "XDG_BIN_HOME" >>= \case
Just r -> pure r
Nothing -> do
home <- liftIO getHomeDirectory
pure (home </> ".local" </> "bin")
else ghcupBaseDir <&> (</> "bin")
#endif
ghcupBinDir
| isWindows = ghcupBaseDir <&> (</> "bin")
| otherwise = do
xdg <- useXDG
if xdg
then do
lookupEnv "XDG_BIN_HOME" >>= \case
Just r -> pure r
Nothing -> do
home <- liftIO getHomeDirectory
pure (home </> ".local" </> "bin")
else ghcupBaseDir <&> (</> "bin")
-- | Defaults to '~/.ghcup/cache'.
@@ -148,21 +141,19 @@ ghcupBinDir = do
-- If 'GHCUP_USE_XDG_DIRS' is set (to anything),
-- then uses 'XDG_CACHE_HOME/ghcup' as per xdg spec.
ghcupCacheDir :: IO FilePath
ghcupCacheDir = do
#if defined(IS_WINDOWS)
ghcupBaseDir <&> (</> "cache")
#else
xdg <- useXDG
if xdg
then do
bdir <- lookupEnv "XDG_CACHE_HOME" >>= \case
Just r -> pure r
Nothing -> do
home <- liftIO getHomeDirectory
pure (home </> ".cache")
pure (bdir </> "ghcup")
else ghcupBaseDir <&> (</> "cache")
#endif
ghcupCacheDir
| isWindows = ghcupBaseDir <&> (</> "cache")
| otherwise = do
xdg <- useXDG
if xdg
then do
bdir <- lookupEnv "XDG_CACHE_HOME" >>= \case
Just r -> pure r
Nothing -> do
home <- liftIO getHomeDirectory
pure (home </> ".cache")
pure (bdir </> "ghcup")
else ghcupBaseDir <&> (</> "cache")
-- | Defaults to '~/.ghcup/logs'.
@@ -170,21 +161,19 @@ ghcupCacheDir = do
-- If 'GHCUP_USE_XDG_DIRS' is set (to anything),
-- then uses 'XDG_CACHE_HOME/ghcup/logs' as per xdg spec.
ghcupLogsDir :: IO FilePath
ghcupLogsDir = do
#if defined(IS_WINDOWS)
ghcupBaseDir <&> (</> "logs")
#else
xdg <- useXDG
if xdg
then do
bdir <- lookupEnv "XDG_CACHE_HOME" >>= \case
Just r -> pure r
Nothing -> do
home <- liftIO getHomeDirectory
pure (home </> ".cache")
pure (bdir </> "ghcup" </> "logs")
else ghcupBaseDir <&> (</> "logs")
#endif
ghcupLogsDir
| isWindows = ghcupBaseDir <&> (</> "logs")
| otherwise = do
xdg <- useXDG
if xdg
then do
bdir <- lookupEnv "XDG_CACHE_HOME" >>= \case
Just r -> pure r
Nothing -> do
home <- liftIO getHomeDirectory
pure (home </> ".cache")
pure (bdir </> "ghcup" </> "logs")
else ghcupBaseDir <&> (</> "logs")
-- | '~/.ghcup/trash'.
@@ -222,7 +211,7 @@ ghcupConfigFile = do
contents <- liftIO $ handleIO' NoSuchThing (\_ -> pure Nothing) $ Just <$> BS.readFile filepath
case contents of
Nothing -> pure defaultUserSettings
Just contents' -> lE' JSONDecodeError . first snd . Y.decode1Strict $ contents'
Just contents' -> lE' JSONDecodeError . first displayException . Y.decodeEither' $ contents'
-------------------------
@@ -320,10 +309,8 @@ withGHCupTmpDir = snd <$> withRunInIO (\run ->
--------------
#if !defined(IS_WINDOWS)
useXDG :: IO Bool
useXDG = isJust <$> lookupEnv "GHCUP_USE_XDG_DIRS"
#endif
relativeSymlink :: FilePath -- ^ the path in which to create the symlink

14
lib/GHCup/Utils/Posix.hs Normal file
View File

@@ -0,0 +1,14 @@
module GHCup.Utils.Posix where
-- | Enables ANSI support on windows, does nothing on unix.
--
-- Returns 'Left str' on errors and 'Right bool' on success, where
-- 'bool' markes whether ansi support was already enabled.
--
-- This function never crashes.
--
-- Rip-off of https://docs.rs/ansi_term/0.12.1/x86_64-pc-windows-msvc/src/ansi_term/windows.rs.html#10-61
enableAnsiSupport :: IO (Either String Bool)
enableAnsiSupport = pure (Right True)

View File

@@ -17,14 +17,25 @@ Portability : portable
GHCup specific prelude. Lots of Excepts functionality.
-}
module GHCup.Utils.Prelude where
module GHCup.Utils.Prelude
(module GHCup.Utils.Prelude,
#if defined(IS_WINDOWS)
import GHCup.Types
module GHCup.Utils.Prelude.Windows
#else
module GHCup.Utils.Prelude.Posix
#endif
)
where
import GHCup.Types
import GHCup.Errors
import GHCup.Types.Optics
import {-# SOURCE #-} GHCup.Utils.Logger
#if defined(IS_WINDOWS)
import GHCup.Utils.Prelude.Windows
#else
import GHCup.Utils.Prelude.Posix
#endif
import Control.Applicative
import Control.Exception.Safe
@@ -33,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( (:|) ))
@@ -45,17 +56,13 @@ import Haskus.Utils.Types.List
import Haskus.Utils.Variant.Excepts
import Text.PrettyPrint.HughesPJClass ( prettyShow, Pretty )
import System.IO.Error
#if defined(IS_WINDOWS)
import System.IO.Temp
#endif
import System.IO.Unsafe
import System.Directory
import System.FilePath
#if defined(IS_WINDOWS)
import Control.Retry
import GHC.IO.Exception
#endif
import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as L
@@ -69,9 +76,6 @@ import qualified Data.Text.Lazy as TL
import qualified Data.Text.Lazy.Builder as B
import qualified Data.Text.Lazy.Builder.Int as B
import qualified Data.Text.Lazy.Encoding as TLE
#if defined(IS_WINDOWS)
import qualified System.Win32.File as Win32
#endif
-- $setup
@@ -309,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
@@ -438,19 +470,17 @@ recyclePathForcibly :: ( MonadIO m
)
=> FilePath
-> m ()
recyclePathForcibly fp = do
#if defined(IS_WINDOWS)
Dirs { recycleDir } <- getDirs
tmp <- liftIO $ createTempDirectory recycleDir "recyclePathForcibly"
let dest = tmp </> takeFileName fp
liftIO (Win32.moveFileEx fp (Just dest) 0)
`catch`
(\e -> if isPermissionError e {- EXDEV on windows -} then recover (liftIO $ removePathForcibly fp) else throwIO e)
`finally`
(liftIO $ handleIO (\_ -> pure ()) $ removePathForcibly tmp)
#else
liftIO $ removePathForcibly fp
#endif
recyclePathForcibly fp
| isWindows = do
Dirs { recycleDir } <- getDirs
tmp <- liftIO $ createTempDirectory recycleDir "recyclePathForcibly"
let dest = tmp </> takeFileName fp
liftIO (moveFile fp dest)
`catch`
(\e -> if isPermissionError e {- EXDEV on windows -} then recover (liftIO $ removePathForcibly fp) else throwIO e)
`finally`
liftIO (handleIO (\_ -> pure ()) $ removePathForcibly tmp)
| otherwise = liftIO $ removePathForcibly fp
rmPathForcibly :: ( MonadIO m
@@ -458,23 +488,17 @@ rmPathForcibly :: ( MonadIO m
)
=> FilePath
-> m ()
rmPathForcibly fp =
#if defined(IS_WINDOWS)
recover (liftIO $ removePathForcibly fp)
#else
liftIO $ removePathForcibly fp
#endif
rmPathForcibly fp
| isWindows = recover (liftIO $ removePathForcibly fp)
| otherwise = liftIO $ removePathForcibly fp
rmDirectory :: (MonadIO m, MonadMask m)
=> FilePath
-> m ()
rmDirectory fp =
#if defined(IS_WINDOWS)
recover (liftIO $ removeDirectory fp)
#else
liftIO $ removeDirectory fp
#endif
rmDirectory fp
| isWindows = recover (liftIO $ removeDirectory fp)
| otherwise = liftIO $ removeDirectory fp
-- https://www.sqlite.org/src/info/89f1848d7f
@@ -486,20 +510,18 @@ recycleFile :: ( MonadIO m
)
=> FilePath
-> m ()
recycleFile fp = do
#if defined(IS_WINDOWS)
Dirs { recycleDir } <- getDirs
liftIO $ whenM (doesDirectoryExist fp) $ ioError (IOError Nothing InappropriateType "recycleFile" "" Nothing (Just fp))
tmp <- liftIO $ createTempDirectory recycleDir "recycleFile"
let dest = tmp </> takeFileName fp
liftIO (Win32.moveFileEx fp (Just dest) 0)
`catch`
(\e -> if isPermissionError e {- EXDEV on windows -} then recover (liftIO $ removePathForcibly fp) else throwIO e)
`finally`
(liftIO $ handleIO (\_ -> pure ()) $ removePathForcibly tmp)
#else
liftIO $ removeFile fp
#endif
recycleFile fp
| isWindows = do
Dirs { recycleDir } <- getDirs
liftIO $ whenM (doesDirectoryExist fp) $ ioError (IOError Nothing InappropriateType "recycleFile" "" Nothing (Just fp))
tmp <- liftIO $ createTempDirectory recycleDir "recycleFile"
let dest = tmp </> takeFileName fp
liftIO (moveFile fp dest)
`catch`
(\e -> if isPermissionError e {- EXDEV on windows -} then recover (liftIO $ removePathForcibly fp) else throwIO e)
`finally`
liftIO (handleIO (\_ -> pure ()) $ removePathForcibly tmp)
| otherwise = liftIO $ removeFile fp
rmFile :: ( MonadIO m
@@ -507,26 +529,19 @@ rmFile :: ( MonadIO m
)
=> FilePath
-> m ()
rmFile fp =
#if defined(IS_WINDOWS)
recover (liftIO $ removeFile fp)
#else
liftIO $ removeFile fp
#endif
rmFile fp
| isWindows = recover (liftIO $ removeFile fp)
| otherwise = liftIO $ removeFile fp
rmDirectoryLink :: (MonadIO m, MonadMask m, MonadReader env m, HasDirs env)
=> FilePath
-> m ()
rmDirectoryLink fp =
#if defined(IS_WINDOWS)
recover (liftIO $ removeDirectoryLink fp)
#else
liftIO $ removeDirectoryLink fp
#endif
rmDirectoryLink fp
| isWindows = recover (liftIO $ removeDirectoryLink fp)
| otherwise = liftIO $ removeDirectoryLink fp
#if defined(IS_WINDOWS)
recover :: (MonadIO m, MonadMask m) => m a -> m a
recover action =
recovering (fullJitterBackoff 25000 <> limitRetries 10)
@@ -535,7 +550,6 @@ recover action =
,\_ -> Handler (\e -> pure (ioeGetErrorType e == UnsatisfiedConstraints))
]
(\_ -> action)
#endif
copyFileE :: (CopyError :< xs, MonadCatch m, MonadIO m) => FilePath -> FilePath -> Excepts xs m ()
@@ -752,5 +766,3 @@ breakOn needle haystack | needle `isPrefixOf` haystack = ([], haystack)
breakOn _ [] = ([], [])
breakOn needle (x:xs) = first (x:) $ breakOn needle xs

View File

@@ -0,0 +1,20 @@
module GHCup.Utils.Prelude.Posix where
import System.Directory
import System.Posix.Files
isWindows, isNotWindows :: Bool
isWindows = False
isNotWindows = not isWindows
moveFile :: FilePath -> FilePath -> IO ()
moveFile = rename
moveFilePortable :: FilePath -> FilePath -> IO ()
moveFilePortable from to = do
copyFile from to
removeFile from

View File

@@ -0,0 +1,17 @@
module GHCup.Utils.Prelude.Windows where
import qualified System.Win32.File as Win32
isWindows, isNotWindows :: Bool
isWindows = True
isNotWindows = not isWindows
moveFile :: FilePath -> FilePath -> IO ()
moveFile from to = Win32.moveFileEx from (Just to) 0
moveFilePortable :: FilePath -> FilePath -> IO ()
moveFilePortable = Win32.moveFile

View File

@@ -0,0 +1,48 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
module GHCup.Utils.Windows where
import Control.Exception.Safe
import Control.Monad
#if !MIN_VERSION_base(4,13,0)
import Control.Monad.Fail ( MonadFail )
#endif
import Data.Bits
import System.Win32.Console
import System.Win32.File hiding ( copyFile )
import System.Win32.Types
-- | Enables ANSI support on windows, does nothing on unix.
--
-- Returns 'Left str' on errors and 'Right bool' on success, where
-- 'bool' markes whether ansi support was already enabled.
--
-- This function never crashes.
--
-- Rip-off of https://docs.rs/ansi_term/0.12.1/x86_64-pc-windows-msvc/src/ansi_term/windows.rs.html#10-61
enableAnsiSupport :: IO (Either String Bool)
enableAnsiSupport = handleIO (pure . Left . displayException) $ do
-- ref: https://docs.microsoft.com/en-us/windows/win32/api/fileapi/nf-fileapi-createfilew
-- Using `CreateFileW("CONOUT$", ...)` to retrieve the console handle works correctly even if STDOUT and/or STDERR are redirected
h <- createFile "CONOUT$" (gENERIC_WRITE .|. gENERIC_READ)
fILE_SHARE_WRITE Nothing oPEN_EXISTING 0 Nothing
when (h == iNVALID_HANDLE_VALUE ) $ fail "invalid handle value"
-- ref: https://docs.microsoft.com/en-us/windows/console/getconsolemode
m <- getConsoleMode h
-- VT processing not already enabled?
if m .&. eNABLE_VIRTUAL_TERMINAL_PROCESSING == 0
-- https://docs.microsoft.com/en-us/windows/console/setconsolemode
then setConsoleMode h (m .|. eNABLE_VIRTUAL_TERMINAL_PROCESSING)
>> pure (Right False)
else pure (Right True)

View File

@@ -28,7 +28,7 @@ import qualified Data.Text as T
-- 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.
ghcupURL :: URI
ghcupURL = [uri|https://www.haskell.org/ghcup/data/ghcup-0.0.6.yaml|]
ghcupURL = [uri|https://raw.githubusercontent.com/haskell/ghcup-metadata/master/ghcup-0.0.6.yaml|]
-- | The current ghcup version.
ghcUpVer :: PVP

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
@@ -201,10 +201,10 @@ download_ghcup() {
i*86)
_url=${base_url}/${ghver}/i386-linux-ghcup-${ghver}
;;
armv7*)
armv7*|*armv8l*)
_url=${base_url}/${ghver}/armv7-linux-ghcup-${ghver}
;;
aarch64|arm64|armv8l)
aarch64|arm64)
# we could be in a 32bit docker container, in which
# case uname doesn't give us what we want
if [ "$(getconf LONG_BIT)" = "32" ] ; then

View File

@@ -17,6 +17,7 @@ extra-deps:
- haskus-utils-data-1.4@sha256:bfa94363b94b14779edd6834fbd59dbb847c3d7b8f48e3844f456ffdc077da4a,1466
- haskus-utils-types-1.5.1@sha256:991c472f4e751e2f0d7aab6ad4220ef151d6160876dcf0511bbf876bbd432020,1298
- haskus-utils-variant-3.1@sha256:e602dd23e068c98d03c1027af20503addef8df6368577622453f44ccabea2a5b,2159
- heaps-0.3.6.1@sha256:7928b759ca5180d35722c45948c0bde264229f3c99c1888188a3d9285f13d3d2,1340
- hpath-filepath-0.10.4@sha256:e9e44fb5fdbade7f30b5b5451257dbee15b6ef1aae4060034d73008bb3b5d878,1269
- hpath-posix-0.13.3@sha256:abe472cf16bccd3a8b8814865ed3551a728fde0f3a2baea2acc03023bec6c565,1615
- hspec-2.7.10@sha256:c9e82c90086acebac576552a06f3cabd249bba048edd1667c7fae0b1313d5bce,1712
@@ -25,6 +26,7 @@ extra-deps:
- hspec-golden-aeson-0.9.0.0@sha256:aa17274114026661ba4dfc9c60c230673c8f408bd86482fd611d2d5cb6aff996,2179
- http-io-streams-0.1.6.0@sha256:53f5bab177efb52cd65ec396fd04ed59b93e5f919fb3700cd7dacd6cfce6f06d,3582
- libarchive-3.0.3.0
- libyaml-streamly-0.2.0
- lzma-static-5.2.5.3@sha256:2758ee58c35992fcf7db78e98684c357a16a82fa2a4e7c352a6c210c08c555d8,7308
- optics-0.4@sha256:9fb69bf0195b8d8f1f8cd0098000946868b8a3c3ffb51e5b64f79fc600c3eb4c,6568
- optics-core-0.4@sha256:59e04aebca536bd011ae50c781937f45af4c1456af1eb9fb578f9a69eee293cd,4995
@@ -33,11 +35,10 @@ extra-deps:
- os-release-1.0.1@sha256:1281c62081f438fc3f0874d3bae6a4887d5964ac25261ba06e29d368ab173467,2716
- primitive-0.7.1.0@sha256:29de6bfd0cf8ba023ceb806203dfbec0e51e3524e75ffe41056f70b4229c6f0f,2728
- regex-posix-clib-2.7
- streamly-0.7.3@sha256:ad2a488fe802692ed47cab9fd0416c2904aac9e51cf2d8aafd1c3a40064c42f5,27421
- streamly-bytestring-0.1.2@sha256:cc828f41d1c714c711d38fb213b4ed186febabba598ab080e13255f69c20b13c,2469
- streamly-posix-0.1.0.1@sha256:5d89b806281035d34020387ed99dde1ddab282c7ed66df3b7cd010b38fd3517b,2138
- streamly-0.8.0@sha256:9784c80ee1ada51477520cabc4e92a0c76a6bb265f968a188f2fce818e7398e0,19654
- strict-base-0.4.0.0@sha256:2ff4e43cb95eedf2995558d7fc34d19362846413dd39e6aa6a5b3ea8228fef9f,1248
- xor-0.0.1.0@sha256:f8362b4a68562b9afbcd727ff64c1a303970df3a032e0033d2f4c094c3501df3,2243
- yaml-streamly-0.12.0
flags:
http-io-streams:

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