Compare commits
1 Commits
issue-328
...
v0.1.17.4-
| Author | SHA1 | Date | |
|---|---|---|---|
185a9822ea
|
@@ -15,9 +15,6 @@ variables:
|
||||
# Bump to invalidate GitLab CI cache.
|
||||
CACHE_REV: 0
|
||||
|
||||
GIT_SUBMODULE_STRATEGY: recursive
|
||||
|
||||
|
||||
############################################################
|
||||
# CI Step
|
||||
############################################################
|
||||
@@ -118,7 +115,7 @@ variables:
|
||||
script:
|
||||
- bash ./.gitlab/script/ghcup_version.sh
|
||||
variables:
|
||||
JSON_VERSION: "0.0.7"
|
||||
JSON_VERSION: "0.0.6"
|
||||
artifacts:
|
||||
expire_in: 2 week
|
||||
paths:
|
||||
@@ -251,7 +248,7 @@ variables:
|
||||
only:
|
||||
- tags
|
||||
variables:
|
||||
JSON_VERSION: "0.0.7"
|
||||
JSON_VERSION: "0.0.6"
|
||||
|
||||
######## stack test ########
|
||||
|
||||
|
||||
@@ -8,15 +8,7 @@ set -eux
|
||||
|
||||
mkdir -p "${TMPDIR}"
|
||||
|
||||
if freebsd-version | grep -E '^12.*' ; then
|
||||
freebsd_ver=12
|
||||
elif freebsd-version | grep -E '^13.*' ; then
|
||||
freebsd_ver=13
|
||||
else
|
||||
(>&2 echo "Unsupported FreeBSD version! Please report a bug at https://gitlab.haskell.org/haskell/ghcup-hs/-/issues")
|
||||
exit 1
|
||||
fi
|
||||
curl -sSfL https://downloads.haskell.org/~ghcup/x86_64-freebsd${freebsd_ver}-ghcup > ./ghcup-bin
|
||||
curl -sSfL https://downloads.haskell.org/~ghcup/x86_64-portbld-freebsd-ghcup > ./ghcup-bin
|
||||
chmod +x ghcup-bin
|
||||
|
||||
./ghcup-bin -v upgrade -i -f
|
||||
|
||||
@@ -1,37 +0,0 @@
|
||||
.
|
||||
./cabal
|
||||
./ghc
|
||||
./ghc-8.10.7
|
||||
./ghc-pkg
|
||||
./ghc-pkg-8.10.7
|
||||
./ghci
|
||||
./ghci-8.10.7
|
||||
./haddock
|
||||
./haddock-8.10.7
|
||||
./haskell-language-server-8.10.6
|
||||
./haskell-language-server-8.10.6~1.6.1.0
|
||||
./haskell-language-server-8.10.7
|
||||
./haskell-language-server-8.10.7~1.6.1.0
|
||||
./haskell-language-server-8.6.5
|
||||
./haskell-language-server-8.6.5~1.6.1.0
|
||||
./haskell-language-server-8.8.4
|
||||
./haskell-language-server-8.8.4~1.6.1.0
|
||||
./haskell-language-server-9.0.1
|
||||
./haskell-language-server-9.0.1~1.6.1.0
|
||||
./haskell-language-server-9.0.2
|
||||
./haskell-language-server-9.0.2~1.6.1.0
|
||||
./haskell-language-server-9.2.1
|
||||
./haskell-language-server-9.2.1~1.6.1.0
|
||||
./haskell-language-server-wrapper
|
||||
./haskell-language-server-wrapper-1.6.1.0
|
||||
./hp2ps
|
||||
./hp2ps-8.10.7
|
||||
./hpc
|
||||
./hpc-8.10.7
|
||||
./hsc2hs
|
||||
./hsc2hs-8.10.7
|
||||
./runghc
|
||||
./runghc-8.10.7
|
||||
./runhaskell
|
||||
./runhaskell-8.10.7
|
||||
./stack
|
||||
@@ -1,81 +0,0 @@
|
||||
.
|
||||
./cabal.exe
|
||||
./cabal.shim
|
||||
./ghc-8.10.7.exe
|
||||
./ghc-8.10.7.shim
|
||||
./ghc-pkg-8.10.7.exe
|
||||
./ghc-pkg-8.10.7.shim
|
||||
./ghc-pkg.exe
|
||||
./ghc-pkg.shim
|
||||
./ghc.exe
|
||||
./ghc.shim
|
||||
./ghci-8.10.7.exe
|
||||
./ghci-8.10.7.shim
|
||||
./ghci.exe
|
||||
./ghci.shim
|
||||
./ghcii-8.10.7.sh-8.10.7.exe
|
||||
./ghcii-8.10.7.sh-8.10.7.shim
|
||||
./ghcii-8.10.7.sh.exe
|
||||
./ghcii-8.10.7.sh.shim
|
||||
./ghcii.sh-8.10.7.exe
|
||||
./ghcii.sh-8.10.7.shim
|
||||
./ghcii.sh.exe
|
||||
./ghcii.sh.shim
|
||||
./haddock-8.10.7.exe
|
||||
./haddock-8.10.7.shim
|
||||
./haddock.exe
|
||||
./haddock.shim
|
||||
./haskell-language-server-8.10.6.exe
|
||||
./haskell-language-server-8.10.6.shim
|
||||
./haskell-language-server-8.10.6~1.6.1.0.exe
|
||||
./haskell-language-server-8.10.6~1.6.1.0.shim
|
||||
./haskell-language-server-8.10.7.exe
|
||||
./haskell-language-server-8.10.7.shim
|
||||
./haskell-language-server-8.10.7~1.6.1.0.exe
|
||||
./haskell-language-server-8.10.7~1.6.1.0.shim
|
||||
./haskell-language-server-8.6.5.exe
|
||||
./haskell-language-server-8.6.5.shim
|
||||
./haskell-language-server-8.6.5~1.6.1.0.exe
|
||||
./haskell-language-server-8.6.5~1.6.1.0.shim
|
||||
./haskell-language-server-8.8.4.exe
|
||||
./haskell-language-server-8.8.4.shim
|
||||
./haskell-language-server-8.8.4~1.6.1.0.exe
|
||||
./haskell-language-server-8.8.4~1.6.1.0.shim
|
||||
./haskell-language-server-9.0.1.exe
|
||||
./haskell-language-server-9.0.1.shim
|
||||
./haskell-language-server-9.0.1~1.6.1.0.exe
|
||||
./haskell-language-server-9.0.1~1.6.1.0.shim
|
||||
./haskell-language-server-9.0.2.exe
|
||||
./haskell-language-server-9.0.2.shim
|
||||
./haskell-language-server-9.0.2~1.6.1.0.exe
|
||||
./haskell-language-server-9.0.2~1.6.1.0.shim
|
||||
./haskell-language-server-9.2.1.exe
|
||||
./haskell-language-server-9.2.1.shim
|
||||
./haskell-language-server-9.2.1~1.6.1.0.exe
|
||||
./haskell-language-server-9.2.1~1.6.1.0.shim
|
||||
./haskell-language-server-wrapper-1.6.1.0.exe
|
||||
./haskell-language-server-wrapper-1.6.1.0.shim
|
||||
./haskell-language-server-wrapper.exe
|
||||
./haskell-language-server-wrapper.shim
|
||||
./hp2ps-8.10.7.exe
|
||||
./hp2ps-8.10.7.shim
|
||||
./hp2ps.exe
|
||||
./hp2ps.shim
|
||||
./hpc-8.10.7.exe
|
||||
./hpc-8.10.7.shim
|
||||
./hpc.exe
|
||||
./hpc.shim
|
||||
./hsc2hs-8.10.7.exe
|
||||
./hsc2hs-8.10.7.shim
|
||||
./hsc2hs.exe
|
||||
./hsc2hs.shim
|
||||
./runghc-8.10.7.exe
|
||||
./runghc-8.10.7.shim
|
||||
./runghc.exe
|
||||
./runghc.shim
|
||||
./runhaskell-8.10.7.exe
|
||||
./runhaskell-8.10.7.shim
|
||||
./runhaskell.exe
|
||||
./runhaskell.shim
|
||||
./stack.exe
|
||||
./stack.shim
|
||||
@@ -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)
|
||||
|
||||
|
||||
@@ -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)
|
||||
|
||||
|
||||
@@ -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)
|
||||
|
||||
|
||||
@@ -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)
|
||||
|
||||
@@ -95,7 +97,6 @@ eghcup --numeric-version
|
||||
|
||||
eghcup install ghc ${GHC_VERSION}
|
||||
[ `$(eghcup whereis ghc ${GHC_VERSION}) --numeric-version` = "${GHC_VERSION}" ]
|
||||
[ `eghcup run --ghc ${GHC_VERSION} -- ghc --numeric-version` = "${GHC_VERSION}" ]
|
||||
eghcup set ghc ${GHC_VERSION}
|
||||
eghcup install cabal ${CABAL_VERSION}
|
||||
[ `$(eghcup whereis cabal ${CABAL_VERSION}) --numeric-version` = "${CABAL_VERSION}" ]
|
||||
@@ -103,22 +104,6 @@ eghcup unset cabal
|
||||
"$GHCUP_BIN"/cabal --version && exit || echo yes
|
||||
eghcup set cabal ${CABAL_VERSION}
|
||||
[ `$(eghcup whereis cabal ${CABAL_VERSION}) --numeric-version` = "${CABAL_VERSION}" ]
|
||||
[ `eghcup run --cabal ${CABAL_VERSION} -- cabal --numeric-version` = "${CABAL_VERSION}" ]
|
||||
|
||||
if [ "${OS}" != "FREEBSD" ] ; then
|
||||
if [ "${ARCH}" = "64" ] ; then
|
||||
eghcup run --ghc 8.10.7 --cabal 3.4.1.0 --hls 1.6.1.0 --stack 2.7.3 --install --bindir "$(pwd)/.bin"
|
||||
if [ "${OS}" == "WINDOWS" ] ; then
|
||||
expected=$(cat "$( cd "$(dirname "$0")" ; pwd -P )/../ghcup-run.files.windows" | sort)
|
||||
else
|
||||
expected=$(cat "$( cd "$(dirname "$0")" ; pwd -P )/../ghcup-run.files" | sort)
|
||||
fi
|
||||
actual=$(cd ".bin" && find . | sort)
|
||||
[ "${actual}" = "${expected}" ]
|
||||
unset actual expected
|
||||
rm -rf .bin
|
||||
fi
|
||||
fi
|
||||
|
||||
cabal --version
|
||||
|
||||
@@ -148,7 +133,7 @@ else
|
||||
eghcup --offline install ghc 8.10.3
|
||||
if [ "${ARCH}" = "64" ] ; then
|
||||
expected=$(cat "$( cd "$(dirname "$0")" ; pwd -P )/../ghc-8.10.3-linux.files" | sort)
|
||||
actual=$(cd "${GHCUP_DIR}/ghc/8.10.3/" && find . | sort)
|
||||
actual=$(cd "${GHCUP_DIR}/ghc/8.10.3/" && find | sort)
|
||||
[ "${actual}" = "${expected}" ]
|
||||
unset actual expected
|
||||
fi
|
||||
@@ -156,7 +141,7 @@ else
|
||||
eghcup prefetch ghc 8.10.3
|
||||
eghcup --offline install ghc 8.10.3
|
||||
expected=$(cat "$( cd "$(dirname "$0")" ; pwd -P )/../ghc-8.10.3-windows.files" | sort)
|
||||
actual=$(cd "${GHCUP_DIR}/ghc/8.10.3/" && find . | sort)
|
||||
actual=$(cd "${GHCUP_DIR}/ghc/8.10.3/" && find | sort)
|
||||
[ "${actual}" = "${expected}" ]
|
||||
unset actual expected
|
||||
else
|
||||
@@ -197,8 +182,6 @@ else
|
||||
fi
|
||||
fi
|
||||
|
||||
|
||||
|
||||
# check that lazy loading works for 'whereis'
|
||||
cp "$CI_PROJECT_DIR/data/metadata/ghcup-${JSON_VERSION}.yaml" "$CI_PROJECT_DIR/data/metadata/ghcup-${JSON_VERSION}.yaml.bak"
|
||||
echo '**' > "$CI_PROJECT_DIR/data/metadata/ghcup-${JSON_VERSION}.yaml"
|
||||
|
||||
4
.gitmodules
vendored
4
.gitmodules
vendored
@@ -1,4 +0,0 @@
|
||||
[submodule "data/metadata"]
|
||||
path = data/metadata
|
||||
url = https://github.com/haskell/ghcup-metadata.git
|
||||
branch = master
|
||||
19
CHANGELOG.md
19
CHANGELOG.md
@@ -1,24 +1,5 @@
|
||||
# Revision history for ghcup
|
||||
|
||||
## 0.1.17.6 -- ????-??-??
|
||||
|
||||
* Vastly improve shell completions wrt [#242](https://gitlab.haskell.org/haskell/ghcup-hs/-/merge_requests/242)
|
||||
* Fix 'ghcup install cabal/hls/stack --set' wrt [#324](https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/324)
|
||||
* Fix bad error message wrt [#323](https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/323)
|
||||
|
||||
## 0.1.17.5 -- 2022-02-26
|
||||
|
||||
* Implement `ghcup run` subcommand wrt [#137](https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/137)
|
||||
* Support installation of dynamic HLS bindists wrt [HLS #2675](https://github.com/haskell/haskell-language-server/pull/2675) and [#237](https://gitlab.haskell.org/haskell/ghcup-hs/-/merge_requests/237)
|
||||
* Fix XDG support when `~/.local/bin` is a symlink wrt [#311](https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/311)
|
||||
* Add support for quilt-style patches wrt [#230](https://gitlab.haskell.org/haskell/ghcup-hs/-/merge_requests/230), by James Hobson
|
||||
* Fix redundant upgrade warnings in `ghcup upgrade`
|
||||
* Fix `ghcup whereis ghc` for non-standard versions wrt [#289](https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/289)
|
||||
* Don't print logs to stdout, but stderr
|
||||
* Allow unpacking legacy lzma archives wrt [#307](https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/307)
|
||||
* Allow to disable self-upgrade functionality wrt [#305](https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/305)
|
||||
* Fix `ghcup install ghc --set` when ghc is already installed wrt [#291](https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/291)
|
||||
|
||||
## 0.1.17.4 -- 2021-11-13
|
||||
|
||||
* add `--metadata-caching` option, allowing to also disable yaml metadata caching wrt [#278](https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/278)
|
||||
|
||||
@@ -493,9 +493,9 @@ set' _ (_, ListResult {..}) = do
|
||||
|
||||
run (do
|
||||
case lTool of
|
||||
GHC -> liftE $ setGHC (GHCTargetVersion lCross lVer) SetGHCOnly Nothing $> ()
|
||||
GHC -> liftE $ setGHC (GHCTargetVersion lCross lVer) SetGHCOnly $> ()
|
||||
Cabal -> liftE $ setCabal lVer $> ()
|
||||
HLS -> liftE $ setHLS lVer SetHLSOnly Nothing $> ()
|
||||
HLS -> liftE $ setHLS lVer $> ()
|
||||
Stack -> liftE $ setStack lVer $> ()
|
||||
GHCup -> pure ()
|
||||
)
|
||||
|
||||
@@ -15,16 +15,13 @@ module GHCup.OptParse (
|
||||
, module GHCup.OptParse.Config
|
||||
, module GHCup.OptParse.Whereis
|
||||
, module GHCup.OptParse.List
|
||||
#ifndef DISABLE_UPGRADE
|
||||
, module GHCup.OptParse.Upgrade
|
||||
#endif
|
||||
, 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.Run
|
||||
, module GHCup.OptParse
|
||||
) where
|
||||
|
||||
@@ -34,14 +31,11 @@ import GHCup.OptParse.Install
|
||||
import GHCup.OptParse.Set
|
||||
import GHCup.OptParse.UnSet
|
||||
import GHCup.OptParse.Rm
|
||||
import GHCup.OptParse.Run
|
||||
import GHCup.OptParse.Compile
|
||||
import GHCup.OptParse.Config
|
||||
import GHCup.OptParse.Whereis
|
||||
import GHCup.OptParse.List
|
||||
#ifndef DISABLE_UPGRADE
|
||||
import GHCup.OptParse.Upgrade
|
||||
#endif
|
||||
import GHCup.OptParse.ChangeLog
|
||||
import GHCup.OptParse.Prefetch
|
||||
import GHCup.OptParse.GC
|
||||
@@ -95,9 +89,7 @@ data Command
|
||||
| Compile CompileCommand
|
||||
| Config ConfigCommand
|
||||
| Whereis WhereisOptions WhereisCommand
|
||||
#ifndef DISABLE_UPGRADE
|
||||
| Upgrade UpgradeOpts Bool
|
||||
#endif
|
||||
| ToolRequirements
|
||||
| ChangeLog ChangeLogOptions
|
||||
| Nuke
|
||||
@@ -106,7 +98,6 @@ data Command
|
||||
#endif
|
||||
| Prefetch PrefetchCommand
|
||||
| GC GCOptions
|
||||
| Run RunOptions
|
||||
|
||||
|
||||
|
||||
@@ -124,7 +115,6 @@ opts =
|
||||
<> metavar "URL"
|
||||
<> help "Alternative ghcup download info url"
|
||||
<> internal
|
||||
<> completer fileUri
|
||||
)
|
||||
)
|
||||
<*> (fmap . fmap) not (invertableSwitch "verify" 'n' True (help "Disable tarball checksum verification (default: enabled)"))
|
||||
@@ -135,7 +125,6 @@ opts =
|
||||
<> help
|
||||
"Keep build directories? (default: errors)"
|
||||
<> hidden
|
||||
<> completer (listCompleter ["always", "errors", "never"])
|
||||
))
|
||||
<*> optional (option
|
||||
(eitherReader downloaderParser)
|
||||
@@ -144,12 +133,10 @@ opts =
|
||||
<> metavar "<internal|curl|wget>"
|
||||
<> help
|
||||
"Downloader to use (default: internal)"
|
||||
<> completer (listCompleter ["internal", "curl", "wget"])
|
||||
#else
|
||||
<> metavar "<curl|wget>"
|
||||
<> help
|
||||
"Downloader to use (default: curl)"
|
||||
<> completer (listCompleter ["curl", "wget"])
|
||||
#endif
|
||||
<> hidden
|
||||
))
|
||||
@@ -160,7 +147,6 @@ opts =
|
||||
<> metavar "<strict|lax|none>"
|
||||
<> help
|
||||
"GPG verification (default: none)"
|
||||
<> completer (listCompleter ["strict", "lax", "none"])
|
||||
))
|
||||
<*> com
|
||||
where
|
||||
@@ -222,7 +208,6 @@ com =
|
||||
(info (List <$> listOpts <**> helper)
|
||||
(progDesc "Show available GHCs and other tools")
|
||||
)
|
||||
#ifndef DISABLE_UPGRADE
|
||||
<> command
|
||||
"upgrade"
|
||||
(info
|
||||
@@ -233,7 +218,6 @@ com =
|
||||
)
|
||||
(progDesc "Upgrade ghcup")
|
||||
)
|
||||
#endif
|
||||
<> command
|
||||
"compile"
|
||||
( Compile
|
||||
@@ -271,16 +255,6 @@ com =
|
||||
(progDesc "Garbage collection"
|
||||
<> footerDoc ( Just $ text gcFooter ))
|
||||
)
|
||||
<> command
|
||||
"run"
|
||||
(Run
|
||||
<$>
|
||||
info
|
||||
(runOpts <**> helper)
|
||||
(progDesc "Run a command with the given tool in PATH"
|
||||
<> footerDoc ( Just $ text runFooter )
|
||||
)
|
||||
)
|
||||
<> commandGroup "Main commands:"
|
||||
)
|
||||
<|> subparser
|
||||
|
||||
@@ -76,7 +76,6 @@ changelogP =
|
||||
)
|
||||
(short 't' <> long "tool" <> metavar "<ghc|cabal|ghcup>" <> help
|
||||
"Open changelog for given tool (default: ghc)"
|
||||
<> completer toolCompleter
|
||||
)
|
||||
)
|
||||
<*> optional (toolVersionArgument Nothing Nothing)
|
||||
|
||||
@@ -3,8 +3,6 @@
|
||||
{-# LANGUAGE FlexibleContexts #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE DuplicateRecordFields #-}
|
||||
{-# LANGUAGE TypeApplications #-}
|
||||
{-# LANGUAGE NumericUnderscores #-}
|
||||
|
||||
module GHCup.OptParse.Common where
|
||||
|
||||
@@ -16,55 +14,36 @@ import GHCup.Platform
|
||||
import GHCup.Types
|
||||
import GHCup.Types.Optics
|
||||
import GHCup.Utils
|
||||
import GHCup.Utils.File
|
||||
import GHCup.Utils.Logger
|
||||
import GHCup.Utils.MegaParsec
|
||||
import GHCup.Utils.Prelude
|
||||
|
||||
import Control.DeepSeq
|
||||
import Control.Concurrent
|
||||
import Control.Concurrent.Async
|
||||
import Control.Exception.Safe
|
||||
#if !MIN_VERSION_base(4,13,0)
|
||||
import Control.Monad.Fail ( MonadFail )
|
||||
#endif
|
||||
import Control.Monad.Reader
|
||||
import Data.Aeson
|
||||
#if MIN_VERSION_aeson(2,0,0)
|
||||
import qualified Data.Aeson.Key as KM
|
||||
import qualified Data.Aeson.KeyMap as KM
|
||||
#else
|
||||
import qualified Data.HashMap.Strict as KM
|
||||
#endif
|
||||
import Data.ByteString.Lazy ( ByteString )
|
||||
import Data.Bifunctor
|
||||
import Data.Char
|
||||
import Data.Either
|
||||
import Data.Functor
|
||||
import Data.List ( nub, sort, sortBy, isPrefixOf, stripPrefix )
|
||||
import Data.List ( nub, sort, sortBy )
|
||||
import Data.Maybe
|
||||
import Data.Text ( Text )
|
||||
import Data.Versions hiding ( str )
|
||||
import Data.Void
|
||||
import qualified Data.Vector as V
|
||||
import GHC.IO.Exception
|
||||
import Haskus.Utils.Variant.Excepts
|
||||
import Options.Applicative hiding ( style )
|
||||
import Prelude hiding ( appendFile )
|
||||
import Safe
|
||||
import System.Directory
|
||||
import System.Process ( readProcess )
|
||||
import System.FilePath
|
||||
import Text.HTML.TagSoup hiding ( Tag )
|
||||
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 qualified System.FilePath.Posix as FP
|
||||
import GHCup.Version
|
||||
import Control.Exception (evaluate)
|
||||
|
||||
|
||||
-------------
|
||||
@@ -110,6 +89,18 @@ toolVersionArgument criteria tool =
|
||||
mv _ = "VERSION|TAG"
|
||||
|
||||
|
||||
toolVersionOption :: Maybe ListCriteria -> Maybe Tool -> Parser ToolVersion
|
||||
toolVersionOption criteria tool =
|
||||
option (eitherReader toolVersionEither)
|
||||
( sh tool
|
||||
<> completer (tagCompleter (fromMaybe GHC tool) [])
|
||||
<> foldMap (completer . versionCompleter criteria) tool)
|
||||
where
|
||||
sh (Just GHC) = long "ghc" <> metavar "GHC_VERSION|TAG"
|
||||
sh (Just HLS) = long "hls" <> metavar "HLS_VERSION|TAG"
|
||||
sh _ = long "version" <> metavar "VERSION|TAG"
|
||||
|
||||
|
||||
versionParser :: Parser GHCTargetVersion
|
||||
versionParser = option
|
||||
(eitherReader tVersionEither)
|
||||
@@ -298,126 +289,6 @@ gpgParser s' | t == T.pack "strict" = Right GPGStrict
|
||||
--[ Completers ]--
|
||||
------------------
|
||||
|
||||
|
||||
toolCompleter :: Completer
|
||||
toolCompleter = listCompleter ["ghc", "cabal", "hls", "stack"]
|
||||
|
||||
gitFileUri :: [String] -> Completer
|
||||
gitFileUri add = mkCompleter $ fileUri' (["git://"] <> add)
|
||||
|
||||
fileUri :: Completer
|
||||
fileUri = mkCompleter $ fileUri' []
|
||||
|
||||
fileUri' :: [String] -> String -> IO [String]
|
||||
fileUri' add = \case
|
||||
"" -> do
|
||||
pwd <- getCurrentDirectory
|
||||
pure $ ["https://", "http://", "file:///", "file://" <> pwd <> "/"] <> add
|
||||
xs
|
||||
| "file:///" `isPrefixOf` xs -> fmap ("file://" <>) <$>
|
||||
case stripPrefix "file://" xs of
|
||||
Nothing -> pure []
|
||||
Just r -> do
|
||||
pwd <- getCurrentDirectory
|
||||
dirs <- compgen "directory" r ["-S", "/"]
|
||||
files <- filter (\f -> (f <> "/") `notElem` dirs) <$> compgen "file" r []
|
||||
pure (dirs <> files <> if r `isPrefixOf` pwd then [pwd <> "/"] else [])
|
||||
| xs `isPrefixOf` "file:///" -> pure ["file:///"]
|
||||
| xs `isPrefixOf` "https://" -> pure ["https://"]
|
||||
| xs `isPrefixOf` "http://" -> pure ["http://"]
|
||||
| otherwise -> pure []
|
||||
where
|
||||
compgen :: String -> String -> [String] -> IO [String]
|
||||
compgen action' r opts = do
|
||||
let cmd = unwords $ ["compgen", "-A", action'] <> opts <> ["--", requote r]
|
||||
result <- tryIO $ readProcess "bash" ["-c", cmd] ""
|
||||
return . lines . either (const []) id $ result
|
||||
|
||||
-- | Strongly quote the string we pass to compgen.
|
||||
--
|
||||
-- We need to do this so bash doesn't expand out any ~ or other
|
||||
-- chars we want to complete on, or emit an end of line error
|
||||
-- when seeking the close to the quote.
|
||||
--
|
||||
-- NOTE: copied from https://hackage.haskell.org/package/optparse-applicative-0.17.0.0/docs/src/Options.Applicative.Builder.Completer.html#requote
|
||||
requote :: String -> String
|
||||
requote s =
|
||||
let
|
||||
-- Bash doesn't appear to allow "mixed" escaping
|
||||
-- in bash completions. So we don't have to really
|
||||
-- worry about people swapping between strong and
|
||||
-- weak quotes.
|
||||
unescaped =
|
||||
case s of
|
||||
-- It's already strongly quoted, so we
|
||||
-- can use it mostly as is, but we must
|
||||
-- ensure it's closed off at the end and
|
||||
-- there's no single quotes in the
|
||||
-- middle which might confuse bash.
|
||||
('\'': rs) -> unescapeN rs
|
||||
|
||||
-- We're weakly quoted.
|
||||
('"': rs) -> unescapeD rs
|
||||
|
||||
-- We're not quoted at all.
|
||||
-- We need to unescape some characters like
|
||||
-- spaces and quotation marks.
|
||||
elsewise -> unescapeU elsewise
|
||||
in
|
||||
strong unescaped
|
||||
|
||||
where
|
||||
strong ss = '\'' : foldr go "'" ss
|
||||
where
|
||||
-- If there's a single quote inside the
|
||||
-- command: exit from the strong quote and
|
||||
-- emit it the quote escaped, then resume.
|
||||
go '\'' t = "'\\''" ++ t
|
||||
go h t = h : t
|
||||
|
||||
-- Unescape a strongly quoted string
|
||||
-- We have two recursive functions, as we
|
||||
-- can enter and exit the strong escaping.
|
||||
unescapeN = goX
|
||||
where
|
||||
goX ('\'' : xs) = goN xs
|
||||
goX (x : xs) = x : goX xs
|
||||
goX [] = []
|
||||
|
||||
goN ('\\' : '\'' : xs) = '\'' : goN xs
|
||||
goN ('\'' : xs) = goX xs
|
||||
goN (x : xs) = x : goN xs
|
||||
goN [] = []
|
||||
|
||||
-- Unescape an unquoted string
|
||||
unescapeU = goX
|
||||
where
|
||||
goX [] = []
|
||||
goX ('\\' : x : xs) = x : goX xs
|
||||
goX (x : xs) = x : goX xs
|
||||
|
||||
-- Unescape a weakly quoted string
|
||||
unescapeD = goX
|
||||
where
|
||||
-- Reached an escape character
|
||||
goX ('\\' : x : xs)
|
||||
-- If it's true escapable, strip the
|
||||
-- slashes, as we're going to strong
|
||||
-- escape instead.
|
||||
| x `elem` ("$`\"\\\n" :: String) = x : goX xs
|
||||
| otherwise = '\\' : x : goX xs
|
||||
-- We've ended quoted section, so we
|
||||
-- don't recurse on goX, it's done.
|
||||
goX ('"' : xs)
|
||||
= xs
|
||||
-- Not done, but not a special character
|
||||
-- just continue the fold.
|
||||
goX (x : xs)
|
||||
= x : goX xs
|
||||
goX []
|
||||
= []
|
||||
|
||||
|
||||
tagCompleter :: Tool -> [String] -> Completer
|
||||
tagCompleter tool add = listIOCompleter $ do
|
||||
dirs' <- liftIO getAllDirs
|
||||
@@ -475,150 +346,6 @@ versionCompleter criteria tool = listIOCompleter $ do
|
||||
return $ T.unpack . prettyVer . lVer <$> installedVersions
|
||||
|
||||
|
||||
toolDlCompleter :: Tool -> Completer
|
||||
toolDlCompleter tool = mkCompleter $ \case
|
||||
"" -> pure (initUrl tool <> ["https://", "http://", "file:///"])
|
||||
word
|
||||
| "file://" `isPrefixOf` word -> fileUri' [] word
|
||||
-- downloads.haskell.org
|
||||
| "https://downloads.haskell.org/" `isPrefixOf` word ->
|
||||
fmap (completePrefix word) . prefixMatch (FP.takeFileName word) <$> fromHRef word
|
||||
|
||||
-- github releases
|
||||
| "https://github.com/haskell/haskell-language-server/releases/download/" `isPrefixOf` word
|
||||
, let xs = splitPath word
|
||||
, (length xs == 6 && last word == '/') || (length xs == 7 && last word /= '/') ->
|
||||
fmap (\x -> completePrefix word x <> "/") . prefixMatch (FP.takeFileName word) <$> getGithubReleases "haskell" "haskell-language-server"
|
||||
| "https://github.com/commercialhaskell/stack/releases/download/" == word
|
||||
, let xs = splitPath word
|
||||
, (length xs == 6 && last word == '/') || (length xs == 7 && last word /= '/') ->
|
||||
fmap (\x -> completePrefix word x <> "/") . prefixMatch (FP.takeFileName word) <$> getGithubReleases "commercialhaskell" "stack"
|
||||
|
||||
-- github release assets
|
||||
| "https://github.com/haskell/haskell-language-server/releases/download/" `isPrefixOf` word
|
||||
, let xs = splitPath word
|
||||
, (length xs == 7 && last word == '/') || length xs == 8
|
||||
, let rel = xs !! 6
|
||||
, length rel > 1 -> do
|
||||
fmap (completePrefix word) . prefixMatch (FP.takeFileName word) <$> getGithubAssets "haskell" "haskell-language-server" (init rel)
|
||||
| "https://github.com/commercialhaskell/stack/releases/download/" `isPrefixOf` word
|
||||
, let xs = splitPath word
|
||||
, (length xs == 7 && last word == '/') || length xs == 8
|
||||
, let rel = xs !! 6
|
||||
, length rel > 1 -> do
|
||||
fmap (completePrefix word) . prefixMatch (FP.takeFileName word) <$> getGithubAssets "commercialhaskell" "stack" (init rel)
|
||||
|
||||
-- github
|
||||
| "https://github.com/c" `isPrefixOf` word -> pure ["https://github.com/commercialhaskell/stack/releases/download/"]
|
||||
| "https://github.com/h" `isPrefixOf` word -> pure ["https://github.com/haskell/haskell-language-server/releases/download/"]
|
||||
| "https://g" `isPrefixOf` word
|
||||
, tool == Stack -> pure ["https://github.com/commercialhaskell/stack/releases/download/"]
|
||||
| "https://g" `isPrefixOf` word
|
||||
, tool == HLS -> pure ["https://github.com/haskell/haskell-language-server/releases/download/"]
|
||||
|
||||
| "https://d" `isPrefixOf` word -> pure $ filter ("https://downloads.haskell.org/" `isPrefixOf`) $ initUrl tool
|
||||
|
||||
| "h" `isPrefixOf` word -> pure $ initUrl tool
|
||||
|
||||
| word `isPrefixOf` "file:///" -> pure ["file:///"]
|
||||
| word `isPrefixOf` "https://" -> pure ["https://"]
|
||||
| word `isPrefixOf` "http://" -> pure ["http://"]
|
||||
|
||||
| otherwise -> pure []
|
||||
where
|
||||
initUrl :: Tool -> [String]
|
||||
initUrl GHC = [ "https://downloads.haskell.org/~ghc/"
|
||||
, "https://downloads.haskell.org/~ghcup/unofficial-bindists/ghc/"
|
||||
]
|
||||
initUrl Cabal = [ "https://downloads.haskell.org/~cabal/"
|
||||
, "https://downloads.haskell.org/~ghcup/unofficial-bindists/cabal/"
|
||||
]
|
||||
initUrl GHCup = [ "https://downloads.haskell.org/~ghcup/" ]
|
||||
initUrl HLS = [ "https://github.com/haskell/haskell-language-server/releases/download/"
|
||||
, "https://downloads.haskell.org/~ghcup/unofficial-bindists/haskell-language-server/"
|
||||
]
|
||||
initUrl Stack = [ "https://github.com/commercialhaskell/stack/releases/download/"
|
||||
, "https://downloads.haskell.org/~ghcup/unofficial-bindists/stack/"
|
||||
]
|
||||
|
||||
completePrefix :: String -- ^ url, e.g. 'https://github.com/haskell/haskell-languag'
|
||||
-> String -- ^ match, e.g. 'haskell-language-server'
|
||||
-> String -- ^ result, e.g. 'https://github.com/haskell/haskell-language-server'
|
||||
completePrefix url match =
|
||||
let base = FP.takeDirectory url
|
||||
fn = FP.takeFileName url
|
||||
in if fn `isPrefixOf` match then base <> "/" <> match else url
|
||||
|
||||
prefixMatch :: String -> [String] -> [String]
|
||||
prefixMatch pref = filter (pref `isPrefixOf`)
|
||||
|
||||
fromHRef :: String -> IO [String]
|
||||
fromHRef url = withCurl (FP.takeDirectory url) 2_000_000 $ \stdout ->
|
||||
pure
|
||||
. fmap (T.unpack . decUTF8Safe' . fromAttrib "href")
|
||||
. filter isTagOpen
|
||||
. filter (~== ("<a href>" :: String))
|
||||
. parseTags
|
||||
$ stdout
|
||||
|
||||
withCurl :: String -- ^ url
|
||||
-> Int -- ^ delay
|
||||
-> (ByteString -> IO [String]) -- ^ callback
|
||||
-> IO [String]
|
||||
withCurl url delay cb = do
|
||||
let limit = threadDelay delay
|
||||
race limit (executeOut "curl" ["-fL", url] Nothing) >>= \case
|
||||
Right (CapturedProcess {_exitCode, _stdOut}) -> do
|
||||
case _exitCode of
|
||||
ExitSuccess ->
|
||||
(try @_ @SomeException . cb $ _stdOut) >>= \case
|
||||
Left _ -> pure []
|
||||
Right r' -> do
|
||||
r <- try @_ @SomeException
|
||||
. evaluate
|
||||
. force
|
||||
$ r'
|
||||
either (\_ -> pure []) pure r
|
||||
ExitFailure _ -> pure []
|
||||
Left _ -> pure []
|
||||
|
||||
getGithubReleases :: String
|
||||
-> String
|
||||
-> IO [String]
|
||||
getGithubReleases owner repo = withCurl url 3_000_000 $ \stdout -> do
|
||||
Just xs <- pure $ decode' @Array stdout
|
||||
fmap V.toList $ forM xs $ \x -> do
|
||||
(Object r) <- pure x
|
||||
Just (String name) <- pure $ KM.lookup (mkval "tag_name") r
|
||||
pure $ T.unpack name
|
||||
where
|
||||
url = "https://api.github.com/repos/" <> owner <> "/" <> repo <> "/releases"
|
||||
|
||||
getGithubAssets :: String
|
||||
-> String
|
||||
-> String
|
||||
-> IO [String]
|
||||
getGithubAssets owner repo tag = withCurl url 3_000_000 $ \stdout -> do
|
||||
Just xs <- pure $ decode' @Object stdout
|
||||
Just (Array assets) <- pure $ KM.lookup (mkval "assets") xs
|
||||
as <- fmap V.toList $ forM assets $ \val -> do
|
||||
(Object asset) <- pure val
|
||||
Just (String name) <- pure $ KM.lookup (mkval "name") asset
|
||||
pure $ T.unpack name
|
||||
pure as
|
||||
where
|
||||
url = "https://api.github.com/repos/" <> owner <> "/" <> repo <> "/releases/tags/" <> tag
|
||||
|
||||
|
||||
#if MIN_VERSION_aeson(2,0,0)
|
||||
mkval = KM.fromString
|
||||
#else
|
||||
mkval = id
|
||||
#endif
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
-----------------
|
||||
|
||||
@@ -165,7 +165,6 @@ ghcCompileOpts =
|
||||
)
|
||||
(short 'v' <> long "version" <> metavar "VERSION" <> help
|
||||
"The tool version to compile"
|
||||
<> (completer $ versionCompleter Nothing GHC)
|
||||
)
|
||||
) <|>
|
||||
(Right <$> (GitBranch <$> option
|
||||
@@ -173,10 +172,7 @@ ghcCompileOpts =
|
||||
(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)"
|
||||
<> completer (gitFileUri ["https://gitlab.haskell.org/ghc/ghc.git"])
|
||||
))
|
||||
optional (option str (short 'r' <> long "repository" <> metavar "GIT_REPOSITORY" <> help "The git repository to build from (defaults to GHC upstream)"))
|
||||
)))
|
||||
<*> option
|
||||
(eitherReader
|
||||
@@ -189,14 +185,12 @@ ghcCompileOpts =
|
||||
<> metavar "BOOTSTRAP_GHC"
|
||||
<> help
|
||||
"The GHC version (or full path) to bootstrap with (must be installed)"
|
||||
<> (completer $ versionCompleter Nothing GHC)
|
||||
)
|
||||
<*> optional
|
||||
(option
|
||||
(eitherReader (readEither @Int))
|
||||
(short 'j' <> long "jobs" <> metavar "JOBS" <> help
|
||||
"How many jobs to use for make"
|
||||
<> (completer $ listCompleter $ fmap show ([1..12] :: [Int]))
|
||||
)
|
||||
)
|
||||
<*> optional
|
||||
@@ -204,7 +198,6 @@ ghcCompileOpts =
|
||||
str
|
||||
(short 'c' <> long "config" <> metavar "CONFIG" <> help
|
||||
"Absolute path to build config file"
|
||||
<> completer (bashCompleter "file")
|
||||
)
|
||||
)
|
||||
<*> (optional
|
||||
@@ -213,15 +206,13 @@ ghcCompileOpts =
|
||||
(eitherReader uriParser)
|
||||
(long "patch" <> metavar "PATCH_URI" <> help
|
||||
"URI to a patch (https/http/file)"
|
||||
<> completer fileUri
|
||||
)
|
||||
)
|
||||
<|>
|
||||
(fmap Left $ 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. This order is determined by a quilt series file if it exists, or the patches are lexicographically ordered)"
|
||||
<> completer (bashCompleter "directory")
|
||||
"Absolute path to patch directory (applies all .patch and .diff files in order using -p1)"
|
||||
)
|
||||
)
|
||||
)
|
||||
@@ -247,7 +238,6 @@ ghcCompileOpts =
|
||||
)
|
||||
(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'"
|
||||
<> (completer $ versionCompleter Nothing GHC)
|
||||
)
|
||||
)
|
||||
<*> optional
|
||||
@@ -267,7 +257,6 @@ ghcCompileOpts =
|
||||
<> long "isolate"
|
||||
<> metavar "DIR"
|
||||
<> help "install in an isolated directory instead of the default one, no symlinks to this installation will be made"
|
||||
<> completer (bashCompleter "directory")
|
||||
)
|
||||
)
|
||||
|
||||
@@ -280,7 +269,6 @@ hlsCompileOpts =
|
||||
)
|
||||
(short 'v' <> long "version" <> metavar "VERSION" <> help
|
||||
"The tool version to compile"
|
||||
<> (completer $ versionCompleter Nothing HLS)
|
||||
)
|
||||
) <|>
|
||||
(Right <$> (GitBranch <$> option
|
||||
@@ -288,16 +276,13 @@ hlsCompileOpts =
|
||||
(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)"
|
||||
<> completer (gitFileUri ["https://github.com/haskell/haskell-language-server.git"])
|
||||
))
|
||||
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"
|
||||
<> (completer $ listCompleter $ fmap show ([1..12] :: [Int]))
|
||||
)
|
||||
)
|
||||
<*> flag
|
||||
@@ -313,7 +298,6 @@ hlsCompileOpts =
|
||||
)
|
||||
(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'"
|
||||
<> (completer $ versionCompleter Nothing HLS)
|
||||
)
|
||||
)
|
||||
<*> optional
|
||||
@@ -323,7 +307,6 @@ hlsCompileOpts =
|
||||
<> long "isolate"
|
||||
<> metavar "DIR"
|
||||
<> help "install in an isolated directory instead of the default one, no symlinks to this installation will be made"
|
||||
<> completer (bashCompleter "directory")
|
||||
)
|
||||
)
|
||||
<*> optional
|
||||
@@ -331,7 +314,6 @@ hlsCompileOpts =
|
||||
((fmap Right $ eitherReader uriParser) <|> (fmap Left str))
|
||||
(long "cabal-project" <> metavar "CABAL_PROJECT" <> help
|
||||
"If relative filepath, specifies the path to cabal.project inside the unpacked HLS tarball/checkout. Otherwise expects a full URI with https/http/file scheme."
|
||||
<> completer fileUri
|
||||
)
|
||||
)
|
||||
<*> optional
|
||||
@@ -339,7 +321,6 @@ hlsCompileOpts =
|
||||
(eitherReader uriParser)
|
||||
(long "cabal-project-local" <> metavar "CABAL_PROJECT_LOCAL" <> help
|
||||
"URI (https/http/file) to a cabal.project.local to be used for the build. Will be copied over."
|
||||
<> completer fileUri
|
||||
)
|
||||
)
|
||||
<*> (optional
|
||||
@@ -348,7 +329,6 @@ hlsCompileOpts =
|
||||
(eitherReader uriParser)
|
||||
(long "patch" <> metavar "PATCH_URI" <> help
|
||||
"URI to a patch (https/http/file)"
|
||||
<> completer fileUri
|
||||
)
|
||||
)
|
||||
<|>
|
||||
@@ -356,17 +336,11 @@ hlsCompileOpts =
|
||||
str
|
||||
(short 'p' <> long "patchdir" <> metavar "PATCH_DIR" <> help
|
||||
"Absolute path to patch directory (applies all .patch and .diff files in order using -p1)"
|
||||
<> completer (bashCompleter "directory")
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
<*> some (
|
||||
option (eitherReader toolVersionEither)
|
||||
( long "ghc" <> metavar "GHC_VERSION|TAG" <> help "For which GHC version to compile for (can be specified multiple times)"
|
||||
<> completer (tagCompleter GHC [])
|
||||
<> completer (versionCompleter Nothing GHC))
|
||||
)
|
||||
<*> some (toolVersionOption Nothing (Just GHC))
|
||||
<*> many (argument str (metavar "CABAL_ARGS" <> help "Additional arguments to cabal install, prefix with '-- ' (longopts)"))
|
||||
|
||||
|
||||
@@ -487,7 +461,7 @@ compile compileCommand settings Dirs{..} runAppState runLogger = do
|
||||
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
||||
let vi = getVersionInfo targetVer HLS dls
|
||||
when setCompile $ void $ liftE $
|
||||
setHLS targetVer SetHLSOnly Nothing
|
||||
setHLS targetVer
|
||||
pure (vi, targetVer)
|
||||
)
|
||||
>>= \case
|
||||
@@ -538,7 +512,7 @@ compile compileCommand settings Dirs{..} runAppState runLogger = do
|
||||
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
||||
let vi = getVersionInfo (_tvVersion targetVer) GHC dls
|
||||
when setCompile $ void $ liftE $
|
||||
setGHC targetVer SetGHCOnly Nothing
|
||||
setGHC targetVer SetGHCOnly
|
||||
pure (vi, targetVer)
|
||||
)
|
||||
>>= \case
|
||||
|
||||
@@ -7,7 +7,6 @@
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE DuplicateRecordFields #-}
|
||||
{-# LANGUAGE RankNTypes #-}
|
||||
{-# LANGUAGE ExplicitForAll #-}
|
||||
|
||||
module GHCup.OptParse.Config where
|
||||
|
||||
@@ -18,7 +17,6 @@ import GHCup.Utils
|
||||
import GHCup.Utils.Prelude
|
||||
import GHCup.Utils.Logger
|
||||
import GHCup.Utils.String.QQ
|
||||
import GHCup.OptParse.Common
|
||||
|
||||
#if !MIN_VERSION_base(4,13,0)
|
||||
import Control.Monad.Fail ( MonadFail )
|
||||
@@ -29,11 +27,10 @@ import Control.Monad.Trans.Resource
|
||||
import Data.Functor
|
||||
import Data.Maybe
|
||||
import Haskus.Utils.Variant.Excepts
|
||||
import Options.Applicative hiding ( style, ParseError )
|
||||
import Options.Applicative hiding ( style )
|
||||
import Options.Applicative.Help.Pretty ( text )
|
||||
import Prelude hiding ( appendFile )
|
||||
import System.Exit
|
||||
import URI.ByteString hiding ( uriParser )
|
||||
|
||||
import qualified Data.Text as T
|
||||
import qualified Data.ByteString.UTF8 as UTF8
|
||||
@@ -52,7 +49,6 @@ data ConfigCommand
|
||||
= ShowConfig
|
||||
| SetConfig String (Maybe String)
|
||||
| InitConfig
|
||||
| AddReleaseChannel URI
|
||||
|
||||
|
||||
|
||||
@@ -66,7 +62,6 @@ configP = subparser
|
||||
( command "init" initP
|
||||
<> command "set" setP -- [set] KEY VALUE at help lhs
|
||||
<> command "show" showP
|
||||
<> command "add-release-channel" addP
|
||||
)
|
||||
<|> argsP -- add show for a single option
|
||||
<|> pure ShowConfig
|
||||
@@ -75,8 +70,6 @@ configP = subparser
|
||||
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"))
|
||||
addP = info (AddReleaseChannel <$> argument (eitherReader uriParser) (metavar "URI" <> completer fileUri))
|
||||
(progDesc "Add a release channel from a URI")
|
||||
|
||||
|
||||
|
||||
@@ -121,18 +114,23 @@ formatConfig :: UserSettings -> String
|
||||
formatConfig = UTF8.toString . Y.encode
|
||||
|
||||
|
||||
updateSettings :: UserSettings -> Settings -> Settings
|
||||
updateSettings 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
|
||||
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
|
||||
|
||||
|
||||
|
||||
@@ -142,7 +140,7 @@ updateSettings UserSettings{..} Settings{..} =
|
||||
|
||||
|
||||
|
||||
config :: forall m. ( Monad m
|
||||
config :: ( Monad m
|
||||
, MonadMask m
|
||||
, MonadUnliftIO m
|
||||
, MonadFail m
|
||||
@@ -163,42 +161,27 @@ config configCommand settings keybindings runLogger = case configCommand of
|
||||
liftIO $ putStrLn $ formatConfig $ fromSettings settings (Just keybindings)
|
||||
pure ExitSuccess
|
||||
|
||||
(SetConfig k mv) -> do
|
||||
r <- runE @'[JSONError, ParseError] $ do
|
||||
case mv of
|
||||
Just "" ->
|
||||
throwE $ ParseError "Empty values are not allowed"
|
||||
Nothing -> do
|
||||
usersettings <- decodeSettings k
|
||||
lift $ doConfig usersettings
|
||||
pure ()
|
||||
Just v -> do
|
||||
usersettings <- decodeSettings (k <> ": " <> v <> "\n")
|
||||
lift $ doConfig usersettings
|
||||
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
|
||||
(SetConfig k (Just v)) ->
|
||||
case v of
|
||||
"" -> do
|
||||
runLogger $ logError "Empty values are not allowed"
|
||||
pure $ ExitFailure 55
|
||||
_ -> doConfig (k <> ": " <> v <> "\n")
|
||||
|
||||
AddReleaseChannel uri -> do
|
||||
case urlSource settings of
|
||||
AddSource xs -> do
|
||||
doConfig (defaultUserSettings { uUrlSource = Just $ AddSource (xs <> [Right uri]) })
|
||||
pure ExitSuccess
|
||||
_ -> do
|
||||
doConfig (defaultUserSettings { uUrlSource = Just $ AddSource [Right uri] })
|
||||
pure ExitSuccess
|
||||
(SetConfig json Nothing) -> doConfig json
|
||||
|
||||
where
|
||||
doConfig :: MonadIO m => UserSettings -> m ()
|
||||
doConfig usersettings = do
|
||||
let settings' = updateSettings usersettings settings
|
||||
path <- liftIO getConfigFilePath
|
||||
liftIO $ writeFile path $ formatConfig $ fromSettings settings' (Just keybindings)
|
||||
runLogger $ logDebug $ T.pack $ show settings'
|
||||
pure ()
|
||||
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 ()
|
||||
|
||||
decodeSettings = lE' (JSONDecodeError . displayException) . Y.decodeEither' . UTF8.fromString
|
||||
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
|
||||
|
||||
@@ -132,7 +132,7 @@ gc GCOptions{..} runAppState runLogger = runGC runAppState (do
|
||||
when gcOldGHC rmOldGHC
|
||||
lift $ when gcProfilingLibs rmProfilingLibs
|
||||
lift $ when gcShareDir rmShareDir
|
||||
liftE $ when gcHLSNoGHC rmHLSNoGHC
|
||||
lift $ when gcHLSNoGHC rmHLSNoGHC
|
||||
lift $ when gcCache rmCache
|
||||
lift $ when gcTmp rmTmp
|
||||
) >>= \case
|
||||
|
||||
@@ -6,7 +6,6 @@
|
||||
{-# LANGUAGE QuasiQuotes #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE DuplicateRecordFields #-}
|
||||
{-# LANGUAGE ViewPatterns #-}
|
||||
|
||||
module GHCup.OptParse.Install where
|
||||
|
||||
@@ -18,6 +17,7 @@ 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
|
||||
|
||||
@@ -190,7 +190,6 @@ installOpts tool =
|
||||
(eitherReader uriParser)
|
||||
(short 'u' <> long "url" <> metavar "BINDIST_URL" <> help
|
||||
"Install the specified version from this bindist"
|
||||
<> completer (toolDlCompleter (fromMaybe GHC tool))
|
||||
)
|
||||
)
|
||||
<*> (Just <$> toolVersionArgument Nothing tool)
|
||||
@@ -210,7 +209,6 @@ installOpts tool =
|
||||
<> long "isolate"
|
||||
<> metavar "DIR"
|
||||
<> help "install in an isolated dir instead of the default one"
|
||||
<> completer (bashCompleter "directory")
|
||||
)
|
||||
)
|
||||
<*> switch
|
||||
@@ -256,48 +254,6 @@ type InstallEffects = '[ AlreadyInstalled
|
||||
, NoToolVersionSet
|
||||
, FileAlreadyExistsError
|
||||
, ProcessError
|
||||
|
||||
, (AlreadyInstalled, ())
|
||||
, (UnknownArchive, ())
|
||||
, (ArchiveResult, ())
|
||||
, (FileDoesNotExistError, ())
|
||||
, (CopyError, ())
|
||||
, (NotInstalled, ())
|
||||
, (DirNotEmpty, ())
|
||||
, (NoDownload, ())
|
||||
, (NotInstalled, ())
|
||||
, (BuildFailed, ())
|
||||
, (TagNotFound, ())
|
||||
, (DigestError, ())
|
||||
, (GPGError, ())
|
||||
, (DownloadFailed, ())
|
||||
, (TarDirDoesNotExist, ())
|
||||
, (NextVerNotFound, ())
|
||||
, (NoToolVersionSet, ())
|
||||
, (FileAlreadyExistsError, ())
|
||||
, (ProcessError, ())
|
||||
|
||||
, (AlreadyInstalled, NotInstalled)
|
||||
, (UnknownArchive, NotInstalled)
|
||||
, (ArchiveResult, NotInstalled)
|
||||
, (FileDoesNotExistError, NotInstalled)
|
||||
, (CopyError, NotInstalled)
|
||||
, (NotInstalled, NotInstalled)
|
||||
, (DirNotEmpty, NotInstalled)
|
||||
, (NoDownload, NotInstalled)
|
||||
, (NotInstalled, NotInstalled)
|
||||
, (BuildFailed, NotInstalled)
|
||||
, (TagNotFound, NotInstalled)
|
||||
, (DigestError, NotInstalled)
|
||||
, (GPGError, NotInstalled)
|
||||
, (DownloadFailed, NotInstalled)
|
||||
, (TarDirDoesNotExist, NotInstalled)
|
||||
, (NextVerNotFound, NotInstalled)
|
||||
, (NoToolVersionSet, NotInstalled)
|
||||
, (FileAlreadyExistsError, NotInstalled)
|
||||
, (ProcessError, NotInstalled)
|
||||
|
||||
, ((), NotInstalled)
|
||||
]
|
||||
|
||||
|
||||
@@ -312,64 +268,6 @@ runInstTool appstate' mInstPlatform =
|
||||
@InstallEffects
|
||||
|
||||
|
||||
type InstallGHCEffects = '[ TagNotFound
|
||||
, NextVerNotFound
|
||||
, NoToolVersionSet
|
||||
, BuildFailed
|
||||
, DirNotEmpty
|
||||
, AlreadyInstalled
|
||||
|
||||
, (AlreadyInstalled, NotInstalled)
|
||||
, (UnknownArchive, NotInstalled)
|
||||
, (ArchiveResult, NotInstalled)
|
||||
, (FileDoesNotExistError, NotInstalled)
|
||||
, (CopyError, NotInstalled)
|
||||
, (NotInstalled, NotInstalled)
|
||||
, (DirNotEmpty, NotInstalled)
|
||||
, (NoDownload, NotInstalled)
|
||||
, (BuildFailed, NotInstalled)
|
||||
, (TagNotFound, NotInstalled)
|
||||
, (DigestError, NotInstalled)
|
||||
, (GPGError, NotInstalled)
|
||||
, (DownloadFailed, NotInstalled)
|
||||
, (TarDirDoesNotExist, NotInstalled)
|
||||
, (NextVerNotFound, NotInstalled)
|
||||
, (NoToolVersionSet, NotInstalled)
|
||||
, (FileAlreadyExistsError, NotInstalled)
|
||||
, (ProcessError, NotInstalled)
|
||||
|
||||
, (AlreadyInstalled, ())
|
||||
, (UnknownArchive, ())
|
||||
, (ArchiveResult, ())
|
||||
, (FileDoesNotExistError, ())
|
||||
, (CopyError, ())
|
||||
, (NotInstalled, ())
|
||||
, (DirNotEmpty, ())
|
||||
, (NoDownload, ())
|
||||
, (BuildFailed, ())
|
||||
, (TagNotFound, ())
|
||||
, (DigestError, ())
|
||||
, (GPGError, ())
|
||||
, (DownloadFailed, ())
|
||||
, (TarDirDoesNotExist, ())
|
||||
, (NextVerNotFound, ())
|
||||
, (NoToolVersionSet, ())
|
||||
, (FileAlreadyExistsError, ())
|
||||
, (ProcessError, ())
|
||||
|
||||
, ((), NotInstalled)
|
||||
]
|
||||
|
||||
runInstGHC :: AppState
|
||||
-> Maybe PlatformRequest
|
||||
-> Excepts InstallGHCEffects (ResourceT (ReaderT AppState IO)) a
|
||||
-> IO (VEither InstallGHCEffects a)
|
||||
runInstGHC appstate' mInstPlatform =
|
||||
flip runReaderT (maybe appstate' (\x -> appstate'{ pfreq = x } :: AppState) mInstPlatform)
|
||||
. runResourceT
|
||||
. runE
|
||||
@InstallGHCEffects
|
||||
|
||||
|
||||
-------------------
|
||||
--[ Entrypoints ]--
|
||||
@@ -390,25 +288,23 @@ install installCommand settings getAppState' runLogger = case installCommand of
|
||||
installGHC InstallOptions{..} = do
|
||||
s'@AppState{ dirs = Dirs{ .. } } <- liftIO getAppState'
|
||||
(case instBindist of
|
||||
Nothing -> runInstGHC s' instPlatform $ do
|
||||
Nothing -> runInstTool s' instPlatform $ do
|
||||
(v, vi) <- liftE $ fromVersion instVer GHC
|
||||
void $ liftE $ sequenceE (installGHCBin
|
||||
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 $ setGHC v SetGHCOnly Nothing
|
||||
pure vi
|
||||
Just uri -> do
|
||||
runInstGHC s'{ settings = settings {noVerify = True}} instPlatform $ do
|
||||
(v, vi) <- liftE $ fromVersion instVer GHC
|
||||
void $ liftE $ sequenceE (installGHCBindist
|
||||
(DownloadInfo uri (Just $ RegexDir "ghc-.*") "")
|
||||
(_tvVersion v)
|
||||
isolateDir
|
||||
forceInstall
|
||||
)
|
||||
$ when instSet $ void $ setGHC v SetGHCOnly Nothing
|
||||
when instSet $ void $ liftE $ setGHC v SetGHCOnly
|
||||
pure vi
|
||||
)
|
||||
>>= \case
|
||||
@@ -417,25 +313,14 @@ install installCommand settings getAppState' runLogger = case installCommand of
|
||||
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 (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 (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)
|
||||
@@ -443,14 +328,6 @@ install installCommand settings getAppState' runLogger = case installCommand of
|
||||
"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 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
|
||||
@@ -463,22 +340,20 @@ install installCommand settings getAppState' runLogger = case installCommand of
|
||||
s'@AppState{ dirs = Dirs{ .. } } <- liftIO getAppState'
|
||||
(case instBindist of
|
||||
Nothing -> runInstTool s' instPlatform $ do
|
||||
(_tvVersion -> v, vi) <- liftE $ fromVersion instVer Cabal
|
||||
void $ liftE $ sequenceE (installCabalBin
|
||||
v
|
||||
isolateDir
|
||||
forceInstall
|
||||
) $ when instSet $ void $ setCabal v
|
||||
(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
|
||||
(_tvVersion -> v, vi) <- liftE $ fromVersion instVer Cabal
|
||||
void $ liftE $ sequenceE (installCabalBindist
|
||||
(DownloadInfo uri Nothing "")
|
||||
v
|
||||
isolateDir
|
||||
forceInstall
|
||||
) $ when instSet $ void $ setCabal v
|
||||
(v, vi) <- liftE $ fromVersion instVer Cabal
|
||||
liftE $ installCabalBindist
|
||||
(DownloadInfo uri Nothing "")
|
||||
(_tvVersion v)
|
||||
isolateDir
|
||||
forceInstall
|
||||
pure vi
|
||||
)
|
||||
>>= \case
|
||||
@@ -495,14 +370,6 @@ install installCommand settings getAppState' runLogger = case installCommand of
|
||||
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 (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
|
||||
@@ -514,23 +381,20 @@ install installCommand settings getAppState' runLogger = case installCommand of
|
||||
s'@AppState{ dirs = Dirs{ .. } } <- liftIO getAppState'
|
||||
(case instBindist of
|
||||
Nothing -> runInstTool s' instPlatform $ do
|
||||
(_tvVersion -> v, vi) <- liftE $ fromVersion instVer HLS
|
||||
void $ liftE $ sequenceE (installHLSBin
|
||||
v
|
||||
isolateDir
|
||||
forceInstall
|
||||
) $ when instSet $ void $ setHLS v SetHLSOnly Nothing
|
||||
(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
|
||||
(_tvVersion -> v, vi) <- liftE $ fromVersion instVer HLS
|
||||
-- TODO: support legacy
|
||||
void $ liftE $ sequenceE (installHLSBindist
|
||||
(DownloadInfo uri (Just $ RegexDir "haskell-language-server-*") "")
|
||||
v
|
||||
isolateDir
|
||||
forceInstall
|
||||
) $ when instSet $ void $ setHLS v SetHLSOnly Nothing
|
||||
(v, vi) <- liftE $ fromVersion instVer HLS
|
||||
liftE $ installHLSBindist
|
||||
(DownloadInfo uri Nothing "")
|
||||
(_tvVersion v)
|
||||
isolateDir
|
||||
forceInstall
|
||||
pure vi
|
||||
)
|
||||
>>= \case
|
||||
@@ -551,18 +415,6 @@ install installCommand settings getAppState' runLogger = case installCommand of
|
||||
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 (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
|
||||
@@ -574,22 +426,20 @@ install installCommand settings getAppState' runLogger = case installCommand of
|
||||
s'@AppState{ dirs = Dirs{ .. } } <- liftIO getAppState'
|
||||
(case instBindist of
|
||||
Nothing -> runInstTool s' instPlatform $ do
|
||||
(_tvVersion -> v, vi) <- liftE $ fromVersion instVer Stack
|
||||
void $ liftE $ sequenceE (installStackBin
|
||||
v
|
||||
isolateDir
|
||||
forceInstall
|
||||
) $ when instSet $ void $ setStack v
|
||||
(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
|
||||
(_tvVersion -> v, vi) <- liftE $ fromVersion instVer Stack
|
||||
void $ liftE $ sequenceE (installStackBindist
|
||||
(DownloadInfo uri Nothing "")
|
||||
v
|
||||
isolateDir
|
||||
forceInstall
|
||||
) $ when instSet $ void $ setStack v
|
||||
(v, vi) <- liftE $ fromVersion instVer Stack
|
||||
liftE $ installStackBindist
|
||||
(DownloadInfo uri Nothing "")
|
||||
(_tvVersion v)
|
||||
isolateDir
|
||||
forceInstall
|
||||
pure vi
|
||||
)
|
||||
>>= \case
|
||||
@@ -606,14 +456,6 @@ install installCommand settings getAppState' runLogger = case installCommand of
|
||||
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 (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
|
||||
|
||||
@@ -69,7 +69,6 @@ listOpts =
|
||||
(eitherReader toolParser)
|
||||
(short 't' <> long "tool" <> metavar "<ghc|cabal|hls|stack>" <> help
|
||||
"Tool to list versions for. Default is all"
|
||||
<> completer (toolCompleter)
|
||||
)
|
||||
)
|
||||
<*> optional
|
||||
@@ -79,7 +78,6 @@ listOpts =
|
||||
<> long "show-criteria"
|
||||
<> metavar "<installed|set|available>"
|
||||
<> help "Show only installed/set/available tool versions"
|
||||
<> completer (listCompleter ["installed", "set", "available"])
|
||||
)
|
||||
)
|
||||
<*> switch
|
||||
|
||||
@@ -83,7 +83,7 @@ prefetchP = subparser
|
||||
(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/)" <> completer (bashCompleter "directory"))))
|
||||
<*> 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")
|
||||
)
|
||||
@@ -92,7 +92,7 @@ prefetchP = subparser
|
||||
"cabal"
|
||||
(info
|
||||
(PrefetchCabal
|
||||
<$> fmap PrefetchOptions (optional (option str (short 'd' <> long "directory" <> help "directory to download into (default: ~/.ghcup/cache/)" <> completer (bashCompleter "directory"))))
|
||||
<$> 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")
|
||||
)
|
||||
@@ -101,7 +101,7 @@ prefetchP = subparser
|
||||
"hls"
|
||||
(info
|
||||
(PrefetchHLS
|
||||
<$> fmap PrefetchOptions (optional (option str (short 'd' <> long "directory" <> help "directory to download into (default: ~/.ghcup/cache/)" <> completer (bashCompleter "directory"))))
|
||||
<$> 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")
|
||||
)
|
||||
@@ -110,7 +110,7 @@ prefetchP = subparser
|
||||
"stack"
|
||||
(info
|
||||
(PrefetchStack
|
||||
<$> fmap PrefetchOptions (optional (option str (short 'd' <> long "directory" <> help "directory to download into (default: ~/.ghcup/cache/)" <> completer (bashCompleter "directory"))))
|
||||
<$> 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")
|
||||
)
|
||||
|
||||
@@ -1,362 +0,0 @@
|
||||
{-# LANGUAGE CPP #-}
|
||||
{-# LANGUAGE QuasiQuotes #-}
|
||||
{-# LANGUAGE TypeApplications #-}
|
||||
{-# LANGUAGE DataKinds #-}
|
||||
{-# LANGUAGE RankNTypes #-}
|
||||
{-# LANGUAGE FlexibleContexts #-}
|
||||
{-# LANGUAGE TypeFamilies #-}
|
||||
module GHCup.OptParse.Run where
|
||||
|
||||
|
||||
import GHCup
|
||||
import GHCup.Utils
|
||||
import GHCup.Utils.Prelude
|
||||
import GHCup.Utils.File
|
||||
import GHCup.OptParse.Common
|
||||
import GHCup.Errors
|
||||
import GHCup.Types
|
||||
import GHCup.Types.Optics ( getDirs )
|
||||
import GHCup.Utils.Logger
|
||||
import GHCup.Utils.String.QQ
|
||||
|
||||
import Control.Exception.Safe ( MonadMask, MonadCatch )
|
||||
#if !MIN_VERSION_base(4,13,0)
|
||||
import Control.Monad.Fail ( MonadFail )
|
||||
#endif
|
||||
import Codec.Archive
|
||||
import Control.Monad.Reader
|
||||
import Control.Monad.Trans.Resource
|
||||
import Data.Functor
|
||||
import Data.Maybe (isNothing)
|
||||
import Data.List ( intercalate )
|
||||
import Haskus.Utils.Variant.Excepts
|
||||
import Options.Applicative hiding ( style )
|
||||
import Prelude hiding ( appendFile )
|
||||
import System.Directory
|
||||
import System.FilePath
|
||||
import System.Environment
|
||||
import System.IO.Temp
|
||||
import System.Exit
|
||||
import Text.PrettyPrint.HughesPJClass ( prettyShow )
|
||||
|
||||
import qualified Data.Map.Strict as Map
|
||||
import qualified Data.Text as T
|
||||
#ifndef IS_WINDOWS
|
||||
import qualified System.Posix.Process as SPP
|
||||
#endif
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
---------------
|
||||
--[ Options ]--
|
||||
---------------
|
||||
|
||||
|
||||
data RunOptions = RunOptions
|
||||
{ runAppendPATH :: Bool
|
||||
, runInstTool' :: Bool
|
||||
, runGHCVer :: Maybe ToolVersion
|
||||
, runCabalVer :: Maybe ToolVersion
|
||||
, runHLSVer :: Maybe ToolVersion
|
||||
, runStackVer :: Maybe ToolVersion
|
||||
, runBinDir :: Maybe FilePath
|
||||
, runCOMMAND :: [String]
|
||||
}
|
||||
|
||||
|
||||
|
||||
---------------
|
||||
--[ Parsers ]--
|
||||
---------------
|
||||
|
||||
|
||||
|
||||
runOpts :: Parser RunOptions
|
||||
runOpts =
|
||||
RunOptions
|
||||
<$> switch
|
||||
(short 'a' <> long "append" <> help "Append bin/ dir to PATH instead of prepending (this means that e.g. a system installation may take precedence)")
|
||||
<*> switch
|
||||
(short 'i' <> long "install" <> help "Install the tool, if missing")
|
||||
<*> optional
|
||||
(option
|
||||
(eitherReader toolVersionEither)
|
||||
(metavar "GHC_VERSION" <> long "ghc" <> help "The ghc version"
|
||||
<> completer (tagCompleter GHC [])
|
||||
<> (completer $ versionCompleter Nothing GHC)
|
||||
)
|
||||
)
|
||||
<*> optional
|
||||
(option
|
||||
(eitherReader toolVersionEither)
|
||||
(metavar "CABAL_VERSION" <> long "cabal" <> help "The cabal version"
|
||||
<> completer (tagCompleter Cabal [])
|
||||
<> (completer $ versionCompleter Nothing Cabal)
|
||||
)
|
||||
)
|
||||
<*> optional
|
||||
(option
|
||||
(eitherReader toolVersionEither)
|
||||
(metavar "HLS_VERSION" <> long "hls" <> help "The HLS version"
|
||||
<> completer (tagCompleter HLS [])
|
||||
<> (completer $ versionCompleter Nothing HLS)
|
||||
)
|
||||
)
|
||||
<*> optional
|
||||
(option
|
||||
(eitherReader toolVersionEither)
|
||||
(metavar "STACK_VERSION" <> long "stack" <> help "The stack version"
|
||||
<> completer (tagCompleter Stack [])
|
||||
<> (completer $ versionCompleter Nothing Stack)
|
||||
)
|
||||
)
|
||||
<*> optional
|
||||
(option
|
||||
(eitherReader isolateParser)
|
||||
( short 'b'
|
||||
<> long "bindir"
|
||||
<> metavar "DIR"
|
||||
<> help "directory where to create the tool symlinks (default: newly created system temp dir)"
|
||||
<> completer (bashCompleter "directory")
|
||||
)
|
||||
)
|
||||
<*> many (argument str (metavar "COMMAND" <> help "The command to run, with arguments (use longopts --). If omitted, just prints the created bin/ dir to stdout and exits."))
|
||||
|
||||
|
||||
|
||||
|
||||
--------------
|
||||
--[ Footer ]--
|
||||
--------------
|
||||
|
||||
|
||||
runFooter :: String
|
||||
runFooter = [s|Discussion:
|
||||
Adds the given tools to a dedicated bin/ directory and adds them to PATH, exposing
|
||||
the relevant binaries, then executes a command.
|
||||
|
||||
Examples:
|
||||
# run VSCode with all latest toolchain exposed, installing missing versions if necessary
|
||||
ghcup run --ghc latest --cabal latest --hls latest --stack latest --install -- code Setup.hs
|
||||
|
||||
# create a custom toolchain bin/ dir with GHC and cabal that can be manually added to PATH
|
||||
ghcup run --ghc 8.10.7 --cabal 3.2.0.0 --bindir $HOME/toolchain/bin
|
||||
|
||||
# run a specific ghc version
|
||||
ghcup run --ghc 8.10.7 -- ghc --version|]
|
||||
|
||||
|
||||
|
||||
|
||||
---------------------------
|
||||
--[ Effect interpreters ]--
|
||||
---------------------------
|
||||
|
||||
|
||||
type RunEffects = '[ AlreadyInstalled
|
||||
, UnknownArchive
|
||||
, ArchiveResult
|
||||
, FileDoesNotExistError
|
||||
, CopyError
|
||||
, NotInstalled
|
||||
, DirNotEmpty
|
||||
, NoDownload
|
||||
, NotInstalled
|
||||
, BuildFailed
|
||||
, TagNotFound
|
||||
, DigestError
|
||||
, GPGError
|
||||
, DownloadFailed
|
||||
, TarDirDoesNotExist
|
||||
, NextVerNotFound
|
||||
, NoToolVersionSet
|
||||
, FileAlreadyExistsError
|
||||
, ProcessError
|
||||
]
|
||||
|
||||
runLeanRUN :: (MonadUnliftIO m, MonadIO m)
|
||||
=> LeanAppState
|
||||
-> Excepts RunEffects (ReaderT LeanAppState m) a
|
||||
-> m (VEither RunEffects a)
|
||||
runLeanRUN 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
|
||||
@RunEffects
|
||||
|
||||
runRUN :: MonadUnliftIO m
|
||||
=> (ReaderT AppState m (VEither RunEffects a) -> m (VEither RunEffects a))
|
||||
-> Excepts RunEffects (ResourceT (ReaderT AppState m)) a
|
||||
-> m (VEither RunEffects a)
|
||||
runRUN runAppState =
|
||||
runAppState
|
||||
. runResourceT
|
||||
. runE
|
||||
@RunEffects
|
||||
|
||||
|
||||
|
||||
------------------
|
||||
--[ Entrypoint ]--
|
||||
------------------
|
||||
|
||||
|
||||
|
||||
run :: forall m.
|
||||
( MonadFail m
|
||||
, MonadMask m
|
||||
, MonadCatch m
|
||||
, MonadIO m
|
||||
, MonadUnliftIO m
|
||||
)
|
||||
=> RunOptions
|
||||
-> (forall a. ReaderT AppState m (VEither RunEffects a) -> m (VEither RunEffects a))
|
||||
-> LeanAppState
|
||||
-> (ReaderT LeanAppState m () -> m ())
|
||||
-> m ExitCode
|
||||
run RunOptions{..} runAppState leanAppstate runLogger = do
|
||||
tmp <- case runBinDir of
|
||||
Just bdir -> do
|
||||
liftIO $ createDirRecursive' bdir
|
||||
liftIO $ canonicalizePath bdir
|
||||
Nothing -> liftIO (getTemporaryDirectory >>= \tmp -> createTempDirectory tmp "ghcup")
|
||||
r <- do
|
||||
addToolsToDir tmp
|
||||
case r of
|
||||
VRight _ -> do
|
||||
case runCOMMAND of
|
||||
[] -> do
|
||||
liftIO $ putStr tmp
|
||||
pure ExitSuccess
|
||||
(cmd:args) -> do
|
||||
newEnv <- liftIO $ addToPath tmp
|
||||
#ifndef IS_WINDOWS
|
||||
void $ liftIO $ SPP.executeFile cmd True args (Just newEnv)
|
||||
pure ExitSuccess
|
||||
#else
|
||||
r' <- runLeanRUN leanAppstate $ liftE $ lEM @_ @'[ProcessError] $ exec cmd args Nothing (Just newEnv)
|
||||
case r' of
|
||||
VRight _ -> pure ExitSuccess
|
||||
VLeft e -> do
|
||||
runLogger $ logError $ T.pack $ prettyShow e
|
||||
pure $ ExitFailure 28
|
||||
#endif
|
||||
VLeft e -> do
|
||||
runLogger $ logError $ T.pack $ prettyShow e
|
||||
pure $ ExitFailure 27
|
||||
where
|
||||
isToolTag :: ToolVersion -> Bool
|
||||
isToolTag (ToolTag _) = True
|
||||
isToolTag _ = False
|
||||
|
||||
-- TODO: doesn't work for cross
|
||||
addToolsToDir tmp
|
||||
| or (fmap (maybe False isToolTag) [runGHCVer, runCabalVer, runHLSVer, runStackVer]) || runInstTool' = runRUN runAppState $ do
|
||||
forM_ runGHCVer $ \ver -> do
|
||||
(v, _) <- liftE $ fromVersion (Just ver) GHC
|
||||
installTool GHC v
|
||||
setTool GHC v tmp
|
||||
forM_ runCabalVer $ \ver -> do
|
||||
(v, _) <- liftE $ fromVersion (Just ver) Cabal
|
||||
installTool Cabal v
|
||||
setTool Cabal v tmp
|
||||
forM_ runHLSVer $ \ver -> do
|
||||
(v, _) <- liftE $ fromVersion (Just ver) HLS
|
||||
installTool HLS v
|
||||
setTool HLS v tmp
|
||||
forM_ runStackVer $ \ver -> do
|
||||
(v, _) <- liftE $ fromVersion (Just ver) Stack
|
||||
installTool Stack v
|
||||
setTool Stack v tmp
|
||||
| otherwise = runLeanRUN leanAppstate $ do
|
||||
case runGHCVer of
|
||||
Just (ToolVersion v) ->
|
||||
setTool GHC v tmp
|
||||
Nothing -> pure ()
|
||||
_ -> fail "Internal error"
|
||||
case runCabalVer of
|
||||
Just (ToolVersion v) ->
|
||||
setTool Cabal v tmp
|
||||
Nothing -> pure ()
|
||||
_ -> fail "Internal error"
|
||||
case runHLSVer of
|
||||
Just (ToolVersion v) ->
|
||||
setTool HLS v tmp
|
||||
Nothing -> pure ()
|
||||
_ -> fail "Internal error"
|
||||
case runStackVer of
|
||||
Just (ToolVersion v) ->
|
||||
setTool Stack v tmp
|
||||
Nothing -> pure ()
|
||||
_ -> fail "Internal error"
|
||||
|
||||
installTool tool v = do
|
||||
isInstalled <- checkIfToolInstalled' tool v
|
||||
case tool of
|
||||
GHC -> do
|
||||
unless isInstalled $ when (runInstTool' && isNothing (_tvTarget v)) $ void $ liftE $ installGHCBin
|
||||
(_tvVersion v)
|
||||
Nothing
|
||||
False
|
||||
Cabal -> do
|
||||
unless isInstalled $ when runInstTool' $ void $ liftE $ installCabalBin
|
||||
(_tvVersion v)
|
||||
Nothing
|
||||
False
|
||||
Stack -> do
|
||||
unless isInstalled $ when runInstTool' $ void $ liftE $ installStackBin
|
||||
(_tvVersion v)
|
||||
Nothing
|
||||
False
|
||||
HLS -> do
|
||||
unless isInstalled $ when runInstTool' $ void $ liftE $ installHLSBin
|
||||
(_tvVersion v)
|
||||
Nothing
|
||||
False
|
||||
GHCup -> pure ()
|
||||
|
||||
setTool tool v tmp =
|
||||
case tool of
|
||||
GHC -> do
|
||||
void $ liftE $ setGHC v SetGHC_XYZ (Just tmp)
|
||||
void $ liftE $ setGHC v SetGHCOnly (Just tmp)
|
||||
Cabal -> do
|
||||
bin <- liftE $ whereIsTool Cabal v
|
||||
cbin <- liftIO $ canonicalizePath bin
|
||||
lift $ createLink (relativeSymlink tmp cbin) (tmp </> ("cabal" <.> exeExt))
|
||||
Stack -> do
|
||||
bin <- liftE $ whereIsTool Stack v
|
||||
cbin <- liftIO $ canonicalizePath bin
|
||||
lift $ createLink (relativeSymlink tmp cbin) (tmp </> ("stack" <.> exeExt))
|
||||
HLS -> do
|
||||
Dirs {..} <- getDirs
|
||||
let v' = _tvVersion v
|
||||
legacy <- isLegacyHLS v'
|
||||
if legacy
|
||||
then do
|
||||
-- TODO: factor this out
|
||||
hlsWrapper <- liftE @_ @'[NotInstalled] $ hlsWrapperBinary v' !? (NotInstalled HLS (mkTVer v'))
|
||||
cw <- liftIO $ canonicalizePath (binDir </> hlsWrapper)
|
||||
lift $ createLink (relativeSymlink tmp cw) (tmp </> takeFileName cw)
|
||||
hlsBins <- hlsServerBinaries v' Nothing >>= liftIO . traverse (canonicalizePath . (binDir </>))
|
||||
forM_ hlsBins $ \bin ->
|
||||
lift $ createLink (relativeSymlink tmp bin) (tmp </> takeFileName bin)
|
||||
liftE $ setHLS (_tvVersion v) SetHLSOnly (Just tmp)
|
||||
else do
|
||||
liftE $ setHLS (_tvVersion v) SetHLS_XYZ (Just tmp)
|
||||
liftE $ setHLS (_tvVersion v) SetHLSOnly (Just tmp)
|
||||
GHCup -> pure ()
|
||||
|
||||
addToPath path = do
|
||||
cEnv <- Map.fromList <$> getEnvironment
|
||||
let paths = ["PATH", "Path"]
|
||||
curPaths = (\x -> maybe [] splitSearchPath (Map.lookup x cEnv)) =<< paths
|
||||
newPath = intercalate [searchPathSeparator] (if runAppendPATH then (curPaths ++ [path]) else (path : curPaths))
|
||||
envWithoutPath = foldr (\x y -> Map.delete x y) cEnv paths
|
||||
pathVar = if isWindows then "Path" else "PATH"
|
||||
envWithNewPath = Map.toList $ Map.insert pathVar newPath envWithoutPath
|
||||
liftIO $ setEnv pathVar newPath
|
||||
return envWithNewPath
|
||||
@@ -271,10 +271,10 @@ set setCommand runAppState runLeanAppState runLogger = case setCommand of
|
||||
-> m ExitCode
|
||||
setGHC' SetOptions{ sToolVer } =
|
||||
case sToolVer of
|
||||
(SetToolVersion v) -> runSetGHC runLeanAppState (liftE $ setGHC v SetGHCOnly Nothing >> pure v)
|
||||
(SetToolVersion v) -> runSetGHC runLeanAppState (liftE $ setGHC v SetGHCOnly >> pure v)
|
||||
_ -> runSetGHC runAppState (do
|
||||
v <- liftE $ fst <$> fromVersion' sToolVer GHC
|
||||
liftE $ setGHC v SetGHCOnly Nothing
|
||||
liftE $ setGHC v SetGHCOnly
|
||||
)
|
||||
>>= \case
|
||||
VRight GHCTargetVersion{..} -> do
|
||||
@@ -311,10 +311,10 @@ set setCommand runAppState runLeanAppState runLogger = case setCommand of
|
||||
-> m ExitCode
|
||||
setHLS' SetOptions{ sToolVer } =
|
||||
case sToolVer of
|
||||
(SetToolVersion v) -> runSetHLS runLeanAppState (liftE $ setHLS (_tvVersion v) SetHLSOnly Nothing >> pure v)
|
||||
(SetToolVersion v) -> runSetHLS runLeanAppState (liftE $ setHLS (_tvVersion v) >> pure v)
|
||||
_ -> runSetHLS runAppState (do
|
||||
v <- liftE $ fst <$> fromVersion' sToolVer HLS
|
||||
liftE $ setHLS (_tvVersion v) SetHLSOnly Nothing
|
||||
liftE $ setHLS (_tvVersion v)
|
||||
pure v
|
||||
)
|
||||
>>= \case
|
||||
|
||||
@@ -72,7 +72,6 @@ upgradeOptsP =
|
||||
str
|
||||
(short 't' <> long "target" <> metavar "TARGET_DIR" <> help
|
||||
"Absolute filepath to write ghcup into"
|
||||
<> completer (bashCompleter "file")
|
||||
)
|
||||
)
|
||||
<|> pure UpgradeGHCupDir
|
||||
|
||||
@@ -82,7 +82,7 @@ toSettings options = do
|
||||
keepDirs = fromMaybe (fromMaybe (Types.keepDirs defaultSettings) uKeepDirs) optKeepDirs
|
||||
downloader = fromMaybe (fromMaybe defaultDownloader uDownloader) optsDownloader
|
||||
keyBindings = maybe defaultKeyBindings mergeKeys uKeyBindings
|
||||
urlSource = maybe (fromMaybe (Types.urlSource defaultSettings) uUrlSource) (OwnSource . (:[]) . Right) optUrlSource
|
||||
urlSource = maybe (fromMaybe (Types.urlSource defaultSettings) uUrlSource) OwnSource optUrlSource
|
||||
noNetwork = fromMaybe (fromMaybe (Types.noNetwork defaultSettings) uNoNetwork) optNoNetwork
|
||||
gpgSetting = fromMaybe (fromMaybe (Types.gpgSetting defaultSettings) uGPGSetting) optGpg
|
||||
in (Settings {..}, keyBindings)
|
||||
@@ -140,12 +140,7 @@ main = do
|
||||
<> hidden
|
||||
)
|
||||
let listCommands = infoOption
|
||||
("install set rm install-cabal list"
|
||||
#ifndef DISABLE_UPGRADE
|
||||
<> " upgrade"
|
||||
#endif
|
||||
<> " compile debug-info tool-requirements changelog"
|
||||
)
|
||||
"install set rm install-cabal list upgrade compile debug-info tool-requirements changelog"
|
||||
( long "list-commands"
|
||||
<> help "List available commands for shell completion"
|
||||
<> internal
|
||||
@@ -243,14 +238,10 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
||||
alreadyInstalling' <- alreadyInstalling optCommand newTool
|
||||
when (not alreadyInstalling') $
|
||||
case t of
|
||||
#ifdef DISABLE_UPGRADE
|
||||
GHCup -> pure ()
|
||||
#else
|
||||
GHCup -> runLogger $
|
||||
logWarn ("New GHCup version available: "
|
||||
<> prettyVer l
|
||||
<> ". To upgrade, run 'ghcup upgrade'")
|
||||
#endif
|
||||
_ -> runLogger $
|
||||
logWarn ("New "
|
||||
<> T.pack (prettyShow t)
|
||||
@@ -305,15 +296,12 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
||||
Config configCommand -> config configCommand settings keybindings runLogger
|
||||
Whereis whereisOptions
|
||||
whereisCommand -> whereis whereisCommand whereisOptions runAppState leanAppstate runLogger
|
||||
#ifndef DISABLE_UPGRADE
|
||||
Upgrade uOpts force' -> upgrade uOpts force' dirs runAppState runLogger
|
||||
#endif
|
||||
ToolRequirements -> toolRequirements runAppState runLogger
|
||||
ChangeLog changelogOpts -> changelog changelogOpts runAppState runLogger
|
||||
Nuke -> nuke appState runLogger
|
||||
Prefetch pfCom -> prefetch pfCom runAppState runLogger
|
||||
GC gcOpts -> gc gcOpts runAppState runLogger
|
||||
Run runCommand -> run runCommand runAppState leanAppstate runLogger
|
||||
|
||||
case res of
|
||||
ExitSuccess -> pure ()
|
||||
@@ -351,9 +339,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
||||
(HLS, ver) = cmp' HLS (Just $ ToolVersion (mkTVer over)) ver
|
||||
alreadyInstalling (Compile (CompileHLS HLSCompileOptions{ targetHLS = Left tver }))
|
||||
(HLS, ver) = cmp' HLS (Just $ ToolVersion (mkTVer tver)) ver
|
||||
#ifndef DISABLE_UPGRADE
|
||||
alreadyInstalling (Upgrade _ _) (GHCup, _) = pure True
|
||||
#endif
|
||||
alreadyInstalling _ _ = pure False
|
||||
|
||||
cmp' :: ( HasLog env
|
||||
|
||||
@@ -8,11 +8,6 @@ package ghcup
|
||||
tests: True
|
||||
flags: +tui
|
||||
|
||||
source-repository-package
|
||||
type: git
|
||||
location: https://github.com/bgamari/terminal-size.git
|
||||
tag: 34ea816bd63f75f800eedac12c6908c6f3736036
|
||||
|
||||
constraints: http-io-streams -brotli,
|
||||
any.Cabal ==3.6.2.0,
|
||||
any.aeson >= 2.0.1.0
|
||||
|
||||
@@ -10,12 +10,13 @@ constraints: any.Cabal ==3.6.2.0,
|
||||
any.StateVar ==1.2.2,
|
||||
any.abstract-deque ==0.3,
|
||||
abstract-deque -usecas,
|
||||
any.aeson ==2.0.2.0,
|
||||
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.7.1,
|
||||
any.ansi-terminal ==0.11.1,
|
||||
any.alex ==3.2.6,
|
||||
alex +small_base,
|
||||
any.ansi-terminal ==0.11,
|
||||
ansi-terminal -example,
|
||||
any.ansi-wl-pprint ==0.6.9,
|
||||
ansi-wl-pprint -example,
|
||||
@@ -52,7 +53,7 @@ constraints: any.Cabal ==3.6.2.0,
|
||||
any.chs-cabal ==0.1.1.1,
|
||||
any.chs-deps ==0.1.0.0,
|
||||
chs-deps -cross,
|
||||
any.clock ==0.8.3,
|
||||
any.clock ==0.8.2,
|
||||
clock -llvm,
|
||||
any.colour ==2.3.6,
|
||||
any.comonad ==5.0.8,
|
||||
@@ -66,7 +67,7 @@ constraints: any.Cabal ==3.6.2.0,
|
||||
contravariant +semigroups +statevar +tagged,
|
||||
any.cpphs ==1.20.9.1,
|
||||
cpphs -old-locale,
|
||||
any.cryptohash-sha1 ==0.11.101.0,
|
||||
any.cryptohash-sha1 ==0.11.100.1,
|
||||
any.cryptohash-sha256 ==0.11.102.1,
|
||||
cryptohash-sha256 -exe +use-cbits,
|
||||
any.data-clist ==0.1.2.3,
|
||||
@@ -87,8 +88,8 @@ constraints: any.Cabal ==3.6.2.0,
|
||||
any.ghc-byteorder ==4.11.0.0.10,
|
||||
any.ghc-prim ==0.6.1,
|
||||
any.happy ==1.20.0,
|
||||
any.hashable ==1.4.0.2,
|
||||
hashable +containers +integer-gmp -random-initial-seed,
|
||||
any.hashable ==1.3.5.0,
|
||||
hashable +integer-gmp -random-initial-seed,
|
||||
any.haskus-utils-data ==1.4,
|
||||
any.haskus-utils-types ==1.5.1,
|
||||
any.haskus-utils-variant ==3.2.1,
|
||||
@@ -112,9 +113,9 @@ constraints: any.Cabal ==3.6.2.0,
|
||||
io-streams +network -nointeractivetests +zlib,
|
||||
any.language-c ==0.9.0.1,
|
||||
language-c -allwarnings +iecfpextension +usebytestrings,
|
||||
any.libarchive ==3.0.3.2,
|
||||
libarchive -cross -low-memory +no-exe -system-libarchive,
|
||||
any.libyaml-streamly ==0.2.1,
|
||||
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,
|
||||
@@ -125,7 +126,7 @@ constraints: any.Cabal ==3.6.2.0,
|
||||
any.microlens-th ==0.4.3.10,
|
||||
any.monad-control ==1.0.3.1,
|
||||
any.mtl ==2.2.2,
|
||||
any.network ==3.1.2.7,
|
||||
any.network ==3.1.2.5,
|
||||
network -devel,
|
||||
any.network-uri ==2.6.4.1,
|
||||
any.openssl-streams ==1.2.3.0,
|
||||
@@ -153,7 +154,7 @@ constraints: any.Cabal ==3.6.2.0,
|
||||
any.random ==1.2.1,
|
||||
any.recursion-schemes ==5.2.2.2,
|
||||
recursion-schemes +template-haskell,
|
||||
any.regex-base ==0.94.0.2,
|
||||
any.regex-base ==0.94.0.1,
|
||||
any.regex-posix ==0.96.0.1,
|
||||
regex-posix -_regex-posix-clib,
|
||||
any.resourcet ==1.2.4.3,
|
||||
@@ -166,15 +167,15 @@ constraints: any.Cabal ==3.6.2.0,
|
||||
scientific -bytestring-builder -integer-simple,
|
||||
any.semialign ==1.2.0.1,
|
||||
semialign +semigroupoids,
|
||||
any.semigroupoids ==5.3.7,
|
||||
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.4,
|
||||
splitmix -optimised-mixer,
|
||||
any.stm ==2.5.0.1,
|
||||
any.streamly ==0.8.1.1,
|
||||
streamly -debug -dev -fusion-plugin -has-llvm -inspection -limit-build-mem -no-fusion +opt -streamk -use-c-malloc,
|
||||
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,
|
||||
@@ -186,14 +187,12 @@ constraints: any.Cabal ==3.6.2.0,
|
||||
any.terminal-size ==0.3.2.1,
|
||||
any.terminfo ==0.4.1.4,
|
||||
any.text ==1.2.4.1,
|
||||
any.text-short ==0.1.5,
|
||||
text-short -asserts,
|
||||
any.text-zipper ==0.11,
|
||||
any.tf-random ==0.5,
|
||||
any.th-abstraction ==0.4.3.0,
|
||||
any.th-compat ==0.1.3,
|
||||
any.th-lift ==0.8.2,
|
||||
any.th-lift-instances ==0.1.19,
|
||||
any.th-lift-instances ==0.1.18,
|
||||
any.these ==1.1.1.1,
|
||||
these +assoc,
|
||||
any.time ==1.9.3,
|
||||
@@ -204,14 +203,12 @@ constraints: any.Cabal ==3.6.2.0,
|
||||
transformers-base +orphaninstances,
|
||||
any.transformers-compat ==0.7.1,
|
||||
transformers-compat -five +five-three -four +generic-deriving +mtl -three -two,
|
||||
any.unicode-data ==0.3.0,
|
||||
unicode-data -ucd2haskell,
|
||||
any.unix ==2.7.2.2,
|
||||
any.unix-bytestring ==0.3.7.6,
|
||||
any.unix-compat ==0.5.4,
|
||||
any.unix-compat ==0.5.3,
|
||||
unix-compat -old-time,
|
||||
any.unliftio-core ==0.2.0.1,
|
||||
any.unordered-containers ==0.2.16.0,
|
||||
any.unordered-containers ==0.2.15.0,
|
||||
unordered-containers -debug,
|
||||
any.uri-bytestring ==0.3.3.1,
|
||||
uri-bytestring -lib-werror,
|
||||
@@ -219,15 +216,15 @@ constraints: any.Cabal ==3.6.2.0,
|
||||
any.uuid-types ==1.0.5,
|
||||
any.vector ==0.12.3.1,
|
||||
vector +boundschecks -internalchecks -unsafechecks -wall,
|
||||
any.versions ==5.0.2,
|
||||
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.1,
|
||||
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 2022-02-15T12:16:42Z
|
||||
index-state: hackage.haskell.org 2021-11-12T11:11:19Z
|
||||
|
||||
@@ -8,11 +8,6 @@ package ghcup
|
||||
tests: True
|
||||
flags: +tui
|
||||
|
||||
source-repository-package
|
||||
type: git
|
||||
location: https://github.com/bgamari/terminal-size.git
|
||||
tag: 34ea816bd63f75f800eedac12c6908c6f3736036
|
||||
|
||||
constraints: http-io-streams -brotli,
|
||||
any.Cabal ==3.6.2.0,
|
||||
any.aeson >= 2.0.1.0
|
||||
@@ -31,4 +26,4 @@ package aeson
|
||||
|
||||
allow-newer: base, ghc-prim, template-haskell, language-c
|
||||
|
||||
with-compiler: ghc-9.0.2
|
||||
with-compiler: ghc-9.0.1
|
||||
@@ -10,12 +10,13 @@ constraints: any.Cabal ==3.6.2.0,
|
||||
any.StateVar ==1.2.2,
|
||||
any.abstract-deque ==0.3,
|
||||
abstract-deque -usecas,
|
||||
any.aeson ==2.0.2.0,
|
||||
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.7.1,
|
||||
any.ansi-terminal ==0.11.1,
|
||||
any.alex ==3.2.6,
|
||||
alex +small_base,
|
||||
any.ansi-terminal ==0.11,
|
||||
ansi-terminal -example,
|
||||
any.ansi-wl-pprint ==0.6.9,
|
||||
ansi-wl-pprint -example,
|
||||
@@ -27,7 +28,7 @@ constraints: any.Cabal ==3.6.2.0,
|
||||
atomic-primops -debug,
|
||||
any.attoparsec ==0.13.2.5,
|
||||
attoparsec -developer,
|
||||
any.base ==4.15.1.0,
|
||||
any.base ==4.15.0.0,
|
||||
any.base-compat ==0.12.1,
|
||||
any.base-compat-batteries ==0.12.1,
|
||||
any.base-orphans ==0.8.6,
|
||||
@@ -52,7 +53,7 @@ constraints: any.Cabal ==3.6.2.0,
|
||||
any.chs-cabal ==0.1.1.1,
|
||||
any.chs-deps ==0.1.0.0,
|
||||
chs-deps -cross,
|
||||
any.clock ==0.8.3,
|
||||
any.clock ==0.8.2,
|
||||
clock -llvm,
|
||||
any.colour ==2.3.6,
|
||||
any.comonad ==5.0.8,
|
||||
@@ -66,13 +67,13 @@ constraints: any.Cabal ==3.6.2.0,
|
||||
contravariant +semigroups +statevar +tagged,
|
||||
any.cpphs ==1.20.9.1,
|
||||
cpphs -old-locale,
|
||||
any.cryptohash-sha1 ==0.11.101.0,
|
||||
any.cryptohash-sha1 ==0.11.100.1,
|
||||
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,
|
||||
any.deepseq ==1.4.5.0,
|
||||
any.directory ==1.3.6.2,
|
||||
any.directory ==1.3.6.1,
|
||||
any.disk-free-space ==0.1.0.1,
|
||||
any.distributive ==0.6.2.1,
|
||||
distributive +semigroups +tagged,
|
||||
@@ -83,13 +84,13 @@ constraints: any.Cabal ==3.6.2.0,
|
||||
any.free ==5.1.7,
|
||||
any.fusion-plugin-types ==0.1.0,
|
||||
any.generic-arbitrary ==0.1.0,
|
||||
any.ghc-bignum ==1.1,
|
||||
any.ghc-boot-th ==9.0.2,
|
||||
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.4.0.2,
|
||||
hashable +containers +integer-gmp -random-initial-seed,
|
||||
any.hashable ==1.3.5.0,
|
||||
hashable +integer-gmp -random-initial-seed,
|
||||
any.haskus-utils-data ==1.4,
|
||||
any.haskus-utils-types ==1.5.1,
|
||||
any.haskus-utils-variant ==3.2.1,
|
||||
@@ -112,9 +113,9 @@ constraints: any.Cabal ==3.6.2.0,
|
||||
io-streams +network -nointeractivetests +zlib,
|
||||
any.language-c ==0.9.0.1,
|
||||
language-c -allwarnings +iecfpextension +usebytestrings,
|
||||
any.libarchive ==3.0.3.2,
|
||||
libarchive -cross -low-memory +no-exe -system-libarchive,
|
||||
any.libyaml-streamly ==0.2.1,
|
||||
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,
|
||||
@@ -125,7 +126,7 @@ constraints: any.Cabal ==3.6.2.0,
|
||||
any.microlens-th ==0.4.3.10,
|
||||
any.monad-control ==1.0.3.1,
|
||||
any.mtl ==2.2.2,
|
||||
any.network ==3.1.2.7,
|
||||
any.network ==3.1.2.5,
|
||||
network -devel,
|
||||
any.network-uri ==2.6.4.1,
|
||||
any.openssl-streams ==1.2.3.0,
|
||||
@@ -146,35 +147,35 @@ constraints: any.Cabal ==3.6.2.0,
|
||||
any.pretty ==1.1.3.6,
|
||||
any.pretty-terminal ==0.1.0.0,
|
||||
any.primitive ==0.7.3.0,
|
||||
any.process ==1.6.13.2,
|
||||
any.process ==1.6.11.0,
|
||||
any.profunctors ==5.6.2,
|
||||
any.quickcheck-arbitrary-adt ==0.3.1.0,
|
||||
any.quickcheck-io ==0.2.0,
|
||||
any.random ==1.2.1,
|
||||
any.recursion-schemes ==5.2.2.2,
|
||||
recursion-schemes +template-haskell,
|
||||
any.regex-base ==0.94.0.2,
|
||||
any.regex-base ==0.94.0.1,
|
||||
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.2,
|
||||
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.semialign ==1.2.0.1,
|
||||
semialign +semigroupoids,
|
||||
any.semigroupoids ==5.3.7,
|
||||
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.4,
|
||||
splitmix -optimised-mixer,
|
||||
any.stm ==2.5.0.0,
|
||||
any.streamly ==0.8.1.1,
|
||||
streamly -debug -dev -fusion-plugin -has-llvm -inspection -limit-build-mem -no-fusion +opt -streamk -use-c-malloc,
|
||||
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,
|
||||
@@ -184,16 +185,14 @@ constraints: any.Cabal ==3.6.2.0,
|
||||
any.temporary ==1.3,
|
||||
any.terminal-progress-bar ==0.4.1,
|
||||
any.terminal-size ==0.3.2.1,
|
||||
any.terminfo ==0.4.1.5,
|
||||
any.text ==1.2.5.0,
|
||||
any.text-short ==0.1.5,
|
||||
text-short -asserts,
|
||||
any.terminfo ==0.4.1.4,
|
||||
any.text ==1.2.4.1,
|
||||
any.text-zipper ==0.11,
|
||||
any.tf-random ==0.5,
|
||||
any.th-abstraction ==0.4.3.0,
|
||||
any.th-compat ==0.1.3,
|
||||
any.th-lift ==0.8.2,
|
||||
any.th-lift-instances ==0.1.19,
|
||||
any.th-lift-instances ==0.1.18,
|
||||
any.these ==1.1.1.1,
|
||||
these +assoc,
|
||||
any.time ==1.9.3,
|
||||
@@ -204,14 +203,12 @@ constraints: any.Cabal ==3.6.2.0,
|
||||
transformers-base +orphaninstances,
|
||||
any.transformers-compat ==0.7.1,
|
||||
transformers-compat -five +five-three -four +generic-deriving +mtl -three -two,
|
||||
any.unicode-data ==0.3.0,
|
||||
unicode-data -ucd2haskell,
|
||||
any.unix ==2.7.2.2,
|
||||
any.unix-bytestring ==0.3.7.6,
|
||||
any.unix-compat ==0.5.4,
|
||||
any.unix-compat ==0.5.3,
|
||||
unix-compat -old-time,
|
||||
any.unliftio-core ==0.2.0.1,
|
||||
any.unordered-containers ==0.2.16.0,
|
||||
any.unordered-containers ==0.2.15.0,
|
||||
unordered-containers -debug,
|
||||
any.uri-bytestring ==0.3.3.1,
|
||||
uri-bytestring -lib-werror,
|
||||
@@ -219,15 +216,15 @@ constraints: any.Cabal ==3.6.2.0,
|
||||
any.uuid-types ==1.0.5,
|
||||
any.vector ==0.12.3.1,
|
||||
vector +boundschecks -internalchecks -unsafechecks -wall,
|
||||
any.versions ==5.0.2,
|
||||
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.1,
|
||||
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 2022-02-15T12:16:42Z
|
||||
index-state: hackage.haskell.org 2021-11-12T11:11:19Z
|
||||
@@ -15,7 +15,8 @@ source-repository-package
|
||||
|
||||
constraints: http-io-streams -brotli,
|
||||
any.Cabal ==3.6.2.0,
|
||||
any.aeson >= 2.0.1.0
|
||||
any.aeson >= 2.0.1.0,
|
||||
streamly == 0.8.0
|
||||
|
||||
package libarchive
|
||||
flags: -system-libarchive
|
||||
|
||||
@@ -48,16 +48,12 @@ url-source:
|
||||
|
||||
## Example 1: Read download info from this location instead
|
||||
## Accepts file/http/https scheme
|
||||
## Can also be an array of URLs or an array of 'Either GHCupInfo URL', in
|
||||
## which case they are merged right-biased (overwriting duplicate versions).
|
||||
# OwnSource: "file:///home/jule/git/ghcup-hs/ghcup-0.0.3.yaml"
|
||||
|
||||
## Example 2: Add custom tarballs to the default downloads, overwriting duplicate versions.
|
||||
## Can also be an array of 'Either GHCupInfo URL', also see Example 3.
|
||||
## Example 2: Add custom tarballs to the default downloads, overwriting duplicate versions
|
||||
# AddSource:
|
||||
# Left:
|
||||
# globalTools: {}
|
||||
# toolRequirements: {}
|
||||
# toolRequirements: {} # this is ignored
|
||||
# ghcupDownloads:
|
||||
# GHC:
|
||||
# 9.10.2:
|
||||
@@ -70,8 +66,6 @@ url-source:
|
||||
# dlSubdir: ghc-7.10.3
|
||||
# dlHash: 01cfbad8dff1e8b34a5fdca8caeaf843b56e36af919e29cd68870d2588563db5
|
||||
|
||||
## Example 3: Add multiple custom download files to the default downloads via right-biased merge (overwriting duplicate
|
||||
## versions).
|
||||
## Example 3: Add a custom download file to the default downloads, overwriting duplicate versions
|
||||
# AddSource:
|
||||
# - Right: "file:///home/jule/git/ghcup-hs/ghcup-prereleases.yaml"
|
||||
# - Right: "file:///home/jule/git/ghcup-hs/ghcup-custom.yaml"
|
||||
# Right: "file:///home/jule/git/ghcup-hs/ghcup-custom.yaml"
|
||||
|
||||
Submodule data/metadata deleted from 6fae2f7bc2
@@ -1,8 +1,5 @@
|
||||
:root {
|
||||
--theme-purple: #5E5184;
|
||||
--theme-purple-dark: rgba(69, 59, 97, 0.5);
|
||||
--ukraine-top: #0057B8;
|
||||
--ukraine-bottom: #FFD700;
|
||||
--link-pink: #9E358F;
|
||||
}
|
||||
|
||||
@@ -111,12 +108,12 @@ body.homepage>div.container div.col-md-9 {
|
||||
|
||||
.bg-primary {
|
||||
background-image: none;
|
||||
background-color: var(--ukraine-top) !important;
|
||||
background-color: var(--theme-purple) !important;
|
||||
}
|
||||
|
||||
body .bg-primary {
|
||||
background-image: none;
|
||||
background-color: var(--ukraine-top);
|
||||
background-color: var(--theme-purple);
|
||||
border: 0px;
|
||||
}
|
||||
|
||||
@@ -128,8 +125,8 @@ body .btn-primary {
|
||||
|
||||
.navbar.fixed-top {
|
||||
background-image: none;
|
||||
background-color: var(--ukraine-top);
|
||||
border-bottom: 40px solid var(--ukraine-bottom);
|
||||
background-color: var(--theme-purple);
|
||||
border-bottom: 5px solid rgba(69, 59, 97, 0.5);
|
||||
padding: 0px;
|
||||
}
|
||||
|
||||
|
||||
27
docs/dev.md
27
docs/dev.md
@@ -12,7 +12,8 @@ organised tree-ish in `GHCup.Utils` and `GHCup.Utils.*`.
|
||||
Anything dealing with ghcup specific directories is in
|
||||
`GHCup.Utils.Dirs`.
|
||||
|
||||
Download information on where to fetch bindists from is in the [ghcup-metadata](https://github.com/haskell/ghcup-metadata) repository.
|
||||
Download information on where to fetch bindists from is in the appropriate
|
||||
yaml files: `data/metadata/ghcup-<yaml-ver>.yaml`.
|
||||
|
||||
## Design decisions
|
||||
|
||||
@@ -88,33 +89,25 @@ Every subcommand now lives in its own module under [GHCup.OptParse.MyCommand](ht
|
||||
|
||||
# Releasing
|
||||
|
||||
1. Update version in `ghcup.cabal`
|
||||
1. Update version in `ghcup.cabal` and `boostrap-haskell` (`ghver` variable at the top of the script)
|
||||
|
||||
2. Update `GHCup.Version` module. `ghcupURL` must only be updated if we change the `GHCupInfo` type or the YAML representation of it. The version of the YAML represents the change increments. `ghcUpVer` is the current application version, read from `ghcup.cabal`.
|
||||
|
||||
3. Add ChangeLog entry
|
||||
|
||||
4. If a new ghcup yaml version is needed, create one at [ghcup-metadata repo](https://github.com/haskell/ghcup-metadata) and push to a temporary release branch, then update the `data/metadata` submodule in ghcup-hs repo to that branch, so CI can pass
|
||||
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 (also check `scripts/releasing/pull_release_artifacts.sh` and `scripts/releasing/sftp-upload-artifacts.sh`)
|
||||
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 [ghcup-metadata repo](https://github.com/haskell/ghcup-metadata)
|
||||
7. Upload the final `ghcup-<ver>.yaml` (and a detached GPG sig of it) to `webhost.haskell.org/ghcup/data/` (for yaml versions <= 0.0.6) as well as [https://github.com/haskell/ghcup-metadata](https://github.com/haskell/ghcup-metadata) (for all versions).
|
||||
|
||||
8. Upload the final `ghcup-<ver>.yaml` (and a detached GPG sig of it) to `webhost.haskell.org/ghcup/data/` (for yaml versions <= 0.0.6) as well as [https://github.com/haskell/ghcup-metadata](https://github.com/haskell/ghcup-metadata) (for all versions).
|
||||
8. Upload `bootstrap-haskell` and `bootstrap-haskell.ps1` to `webhost.haskell.org/ghcup/sh/`
|
||||
|
||||
9. Update version in `scripts/bootstrap/bootstrap-haskell` (`ghver` variable at the top of the script)
|
||||
9. Update the top-level ghcup symlinks at `downloads.haskell.org/~ghcup`
|
||||
|
||||
10. Upload `scripts/bootstrap/bootstrap-haskell` and `scripts/bootstrap/bootstrap-haskell.ps1` to `webhost.haskell.org/ghcup/sh/`
|
||||
|
||||
11. Update the top-level ghcup symlinks at `downloads.haskell.org/~ghcup` (see `scripts/releasing/sftp-symlink-artifacts.sh`)
|
||||
|
||||
12. Update the `data/metadata` submodule in ghcup-hs repo to master
|
||||
|
||||
13. Do hackage release
|
||||
|
||||
14. Post on reddit/discourse/etc. and collect rewards
|
||||
10. Post on reddit/discourse/etc. and collect rewards
|
||||
|
||||
# Documentation
|
||||
|
||||
|
||||
144
docs/guide.md
144
docs/guide.md
@@ -32,17 +32,6 @@ ghcup install cabal
|
||||
ghcup upgrade
|
||||
```
|
||||
|
||||
### Tags and shortcuts
|
||||
|
||||
GHCup has a number of tags and version shortcuts, that can be used as arguments to **install**/**set** etc.
|
||||
All of the following are valid arguments to `ghcup install ghc`:
|
||||
|
||||
* `latest`, `recommended`
|
||||
* `base-4.15.1.0`
|
||||
* `9.0.2`, `9.0`, `9`
|
||||
|
||||
If the argument is omitted, the default is `recommended`.
|
||||
|
||||
## Configuration
|
||||
|
||||
A configuration file can be put in `~/.ghcup/config.yaml`. The default config file
|
||||
@@ -149,31 +138,6 @@ and produce the binaries `ghc-8.10.2-eff` and `ghc-head` respectively.
|
||||
GHCup always needs to know which version the bindist corresponds to (this is not automatically
|
||||
detected).
|
||||
|
||||
## Mirrors
|
||||
|
||||
GHCup allows to use custom mirrors/download-info hosted by yourself or 3rd parties.
|
||||
|
||||
To use a mirror, set the following option in `~/.ghcup/config.yaml`:
|
||||
|
||||
```yml
|
||||
url-source:
|
||||
# Accepts file/http/https scheme
|
||||
OwnSource: "https://some-url/ghcup-0.0.6.yaml"
|
||||
```
|
||||
|
||||
See [config.yaml](https://gitlab.haskell.org/haskell/ghcup-hs/-/blob/master/data/config.yaml)
|
||||
for more options.
|
||||
|
||||
Alternatively you can do it via a cli switch:
|
||||
|
||||
```sh
|
||||
ghcup --url-source=https://some-url/ghcup-0.0.6.yaml list
|
||||
```
|
||||
|
||||
### Known mirrors
|
||||
|
||||
1. [https://mirror.sjtu.edu.cn/docs/ghcup](https://mirror.sjtu.edu.cn/docs/ghcup)
|
||||
|
||||
## Isolated installs
|
||||
|
||||
Ghcup also enables you to install a tool (GHC, Cabal, HLS, Stack) at an isolated location of your choosing.
|
||||
@@ -224,10 +188,66 @@ For the full list of env variables and parameters to tweak the script behavior,
|
||||
* [bootstrap-haskell for linux/darwin/freebsd](https://gitlab.haskell.org/haskell/ghcup-hs/-/blob/master/scripts/bootstrap/bootstrap-haskell#L7)
|
||||
* [bootstrap-haskell.ps1 for windows](https://gitlab.haskell.org/haskell/ghcup-hs/-/blob/master/scripts/bootstrap/bootstrap-haskell.ps1#L17)
|
||||
|
||||
### github workflows
|
||||
### Example github workflow
|
||||
|
||||
On github workflows you can use [https://github.com/haskell/actions/](https://github.com/haskell/actions/).
|
||||
GHCup itself is also pre-installed on all platforms, but may use non-standard install locations.
|
||||
On github workflows you can use [https://github.com/haskell/actions/](https://github.com/haskell/actions/)
|
||||
|
||||
If you want to install ghcup manually though, here's an example config:
|
||||
|
||||
```yml
|
||||
name: Haskell CI
|
||||
|
||||
on:
|
||||
push:
|
||||
branches: [ master ]
|
||||
pull_request:
|
||||
branches: [ master ]
|
||||
|
||||
jobs:
|
||||
build-cabal:
|
||||
|
||||
runs-on: ${{ matrix.os }}
|
||||
strategy:
|
||||
fail-fast: false
|
||||
matrix:
|
||||
os: [ubuntu-latest, macOS-latest, windows-latest]
|
||||
ghc: ['8.10.7', '9.0.1']
|
||||
cabal: ['3.4.0.0']
|
||||
|
||||
steps:
|
||||
- uses: actions/checkout@v2
|
||||
|
||||
- if: matrix.os == 'windows-latest'
|
||||
name: Install ghcup on windows
|
||||
run: Set-ExecutionPolicy Bypass -Scope Process -Force;[System.Net.ServicePointManager]::SecurityProtocol = [System.Net.ServicePointManager]::SecurityProtocol -bor 3072;Invoke-Command -ScriptBlock ([ScriptBlock]::Create((Invoke-WebRequest https://www.haskell.org/ghcup/sh/bootstrap-haskell.ps1 -UseBasicParsing))) -ArgumentList $false,$true,$true,$false,$false,$false,$false,"C:\"
|
||||
|
||||
- if: matrix.os == 'windows-latest'
|
||||
name: Add ghcup to PATH
|
||||
run: echo "/c/ghcup/bin" >> $GITHUB_PATH
|
||||
shell: bash
|
||||
|
||||
- if: matrix.os != 'windows-latest'
|
||||
name: Install ghcup on non-windows
|
||||
run: curl --proto '=https' --tlsv1.2 -sSf https://get-ghcup.haskell.org | BOOTSTRAP_HASKELL_NONINTERACTIVE=1 BOOTSTRAP_HASKELL_MINIMAL=1 sh
|
||||
|
||||
- name: Install ghc/cabal
|
||||
run: |
|
||||
ghcup install ghc ${{ matrix.ghc }}
|
||||
ghcup install cabal ${{ matrix.cabal }}
|
||||
shell: bash
|
||||
|
||||
- name: Update cabal index
|
||||
run: cabal update
|
||||
shell: bash
|
||||
|
||||
- name: Build
|
||||
run: cabal build --enable-tests --enable-benchmarks
|
||||
shell: bash
|
||||
|
||||
- name: Run tests
|
||||
run: cabal test
|
||||
shell: bash
|
||||
```
|
||||
|
||||
## GPG verification
|
||||
|
||||
@@ -259,14 +279,48 @@ You can also pass the mode via `ghcup --gpg <strict|lax|none>`.
|
||||
|
||||
## Tips and tricks
|
||||
|
||||
### Execute command with certain GHC in PATH
|
||||
### with_ghc wrapper (e.g. for HLS)
|
||||
|
||||
If you don't want to explicitly switch the active GHC all the time and are using
|
||||
tools that rely on the plain `ghc` binary, GHCup provides an easy way to execute
|
||||
commands with a certain toolchain prepended to PATH, e.g.:
|
||||
Due to some HLS [bugs](https://github.com/mpickering/hie-bios/issues/194) it's necessary that the `ghc` in PATH
|
||||
is the one defined in `cabal.project`. With some simple shell functions, we can start our editor with the appropriate
|
||||
path prepended.
|
||||
|
||||
For bash, in e.g. `~/.bashrc` define:
|
||||
|
||||
```sh
|
||||
ghcup run --ghc 8.10.7 --cabal latest --hls latest --stack latest --install -- code Setup.hs
|
||||
with_ghc() {
|
||||
local np=$(ghcup --offline whereis -d ghc $1 || { ghcup --cache install ghc $1 && ghcup whereis -d ghc $1 ;})
|
||||
if [ -e "${np}" ] ; then
|
||||
shift
|
||||
PATH="$np:$PATH" "$@"
|
||||
else
|
||||
>&2 echo "Cannot find or install GHC version $1"
|
||||
return 1
|
||||
fi
|
||||
}
|
||||
```
|
||||
|
||||
This will execute vscode with GHC set to 8.10.7 and all other tools to their latest version.
|
||||
For fish shell, in e.g. `~/.config/fish/config.fish` define:
|
||||
|
||||
```fish
|
||||
function with_ghc
|
||||
set --local np (ghcup --offline whereis -d ghc $argv[1] ; or begin ghcup --cache install ghc $argv[1] ; and ghcup whereis -d ghc $argv[1] ; end)
|
||||
if test -e "$np"
|
||||
PATH="$np:$PATH" $argv[2..-1]
|
||||
else
|
||||
echo "Cannot find or install GHC version $argv[1]" 1>&2
|
||||
return 1
|
||||
end
|
||||
end
|
||||
```
|
||||
|
||||
Then start a new shell and issue:
|
||||
|
||||
```sh
|
||||
# replace 'code' with your editor
|
||||
with_ghc 8.10.5 code path/to/haskell/source
|
||||
```
|
||||
|
||||
Cabal and HLS will now see `8.10.5` as the primary GHC, without the need to
|
||||
run `ghcup set` all the time when switching between projects.
|
||||
|
||||
|
||||
111
docs/install.md
111
docs/install.md
@@ -24,20 +24,10 @@ Set-ExecutionPolicy Bypass -Scope Process -Force;[System.Net.ServicePointManager
|
||||
|
||||
If you want to know what these scripts do, check out the [source code at the repository](https://gitlab.haskell.org/haskell/ghcup-hs/-/tree/master/scripts/bootstrap). Advanced users may want to perform a [manual installation](#manual-install) and GPG verify the binaries.
|
||||
|
||||
### Which versions get installed?
|
||||
|
||||
GHCup has two main channels for every tool: **recommended** and **latest**. By default, it installs *recommended*.
|
||||
|
||||
*latest* follows the latest release of every tool, while *recommended* is at the discretion of the GHCup maintainers and based on community adoption (hackage libraries, tools like HLS, stackage support, etc.) and known bugs.
|
||||
|
||||
Also see [tags and shortcuts](../guide/#tags-and-shortcuts) for more information.
|
||||
|
||||
## First steps
|
||||
|
||||
1. To get started with creating a Haskell project, follow the [Getting Started with Haskell and Cabal](https://cabal.readthedocs.io/en/stable/getting-started.html) guide
|
||||
2. To learn Haskell, try any of those:
|
||||
- A beginner friendly [4-lectures course](https://github.com/haskell-beginners-2022/course-plan) with exercises (by [Kowainik](https://kowainik.github.io/))
|
||||
- An in-depth university [CIS 194 Haskell course](https://www.cis.upenn.edu/~cis194/spring13/) including exercises (by [Brent Yorgey](https://byorgey.wordpress.com/))
|
||||
1. To get started with creating a Haskell project, follow the [Getting Started with Haskell and Cabal](https://cabal.readthedocs.io/en/latest/getting-started.html) guide
|
||||
2. To properly learn Haskell, run through the [CIS 194 Haskell course](https://www.cis.upenn.edu/~cis194/spring13/) including exercises
|
||||
3. To learn more about Haskell Toolchain management, check out the [ghcup user guide](./guide.md)
|
||||
|
||||
## Uninstallation
|
||||
@@ -50,90 +40,10 @@ On windows, double-click on the `Uninstall Haskell.ps1` PowerShell script on you
|
||||
|
||||
GHCup supports the following tools, which are also known as the **Haskell Toolchain**:
|
||||
|
||||
<details>
|
||||
<summary>Show all supported <a href='https://www.haskell.org/ghc/'>GHC</a> versions</summary>
|
||||
|
||||
<table>
|
||||
<thead><tr><th>GHC Version</th><th>Tags</th></tr></thead>
|
||||
<tbody>
|
||||
<tr><td>7.10.3</td><td>base-4.8.2.0</td></tr>
|
||||
<tr><td>8.0.2</td><td>base-4.9.1.0</td></tr>
|
||||
<tr><td>8.2.2</td><td>base-4.10.1.0</td></tr>
|
||||
<tr><td>8.4.1</td><td>base-4.11.0.0</td></tr>
|
||||
<tr><td>8.4.2</td><td>base-4.11.1.0</td></tr>
|
||||
<tr><td>8.4.3</td><td>base-4.11.1.0</td></tr>
|
||||
<tr><td>8.4.4</td><td>base-4.11.1.0</td></tr>
|
||||
<tr><td>8.6.1</td><td>base-4.12.0.0</td></tr>
|
||||
<tr><td>8.6.2</td><td>base-4.12.0.0</td></tr>
|
||||
<tr><td>8.6.3</td><td>base-4.12.0.0</td></tr>
|
||||
<tr><td>8.6.4</td><td>base-4.12.0.0</td></tr>
|
||||
<tr><td>8.6.5</td><td>base-4.12.0.0</td></tr>
|
||||
<tr><td>8.8.1</td><td>base-4.13.0.0</td></tr>
|
||||
<tr><td>8.8.2</td><td>base-4.13.0.0</td></tr>
|
||||
<tr><td>8.8.3</td><td>base-4.13.0.0</td></tr>
|
||||
<tr><td>8.8.4</td><td>base-4.13.0.0</td></tr>
|
||||
<tr><td>8.10.1</td><td>base-4.14.0.0</td></tr>
|
||||
<tr><td>8.10.2</td><td>base-4.14.1.0</td></tr>
|
||||
<tr><td>8.10.3</td><td>base-4.14.1.0</td></tr>
|
||||
<tr><td>8.10.4</td><td>base-4.14.1.0</td></tr>
|
||||
<tr><td>8.10.5</td><td>base-4.14.2.0</td></tr>
|
||||
<tr><td>8.10.6</td><td>base-4.14.3.0</td></tr>
|
||||
<tr><td>8.10.7</td><td><span style="color:green">recommended</span>, base-4.14.3.0</td></tr>
|
||||
<tr><td>9.0.1</td><td>base-4.15.0.0</td></tr>
|
||||
<tr><td>9.0.2</td><td>base-4.15.1.0</td></tr>
|
||||
<tr><td>9.2.1</td><td>base-4.16.0.0</td></tr>
|
||||
<tr><td>9.2.2</td><td><span style="color:blue">latest</span>, base-4.16.1.0</td></tr>
|
||||
</tbody>
|
||||
</table>
|
||||
|
||||
</details>
|
||||
|
||||
<details>
|
||||
<summary>Show all supported <a href='https://cabal.readthedocs.io/en/stable/'>cabal-install</a> versions</summary>
|
||||
<table>
|
||||
<thead><tr><th>Cabal Version</th><th>Tags</th></tr></thead>
|
||||
<tbody>
|
||||
<tr><td>2.4.1.0</td><td></td></tr>
|
||||
<tr><td>3.0.0.0</td><td></td></tr>
|
||||
<tr><td>3.2.0.0</td><td></td></tr>
|
||||
<tr><td>3.4.0.0</td><td></td></tr>
|
||||
<tr><td>3.4.1.0</td><td></td></tr>
|
||||
<tr><td>3.6.0.0</td><td></td></tr>
|
||||
<tr><td>3.6.2.0</td><td><span style="color:blue">latest</span>, <span style="color:green">recommended</span></td></tr>
|
||||
</tbody>
|
||||
</table>
|
||||
|
||||
</details>
|
||||
|
||||
<details>
|
||||
<summary>Show all supported <a href='https://haskell-language-server.readthedocs.io/en/stable/'>HLS</a> versions</summary>
|
||||
<table>
|
||||
<thead><tr><th>HLS Version</th><th>Tags</th></tr></thead>
|
||||
<tbody>
|
||||
<tr><td>1.1.0</td><td></td></tr>
|
||||
<tr><td>1.2.0</td><td></td></tr>
|
||||
<tr><td>1.3.0</td><td></td></tr>
|
||||
<tr><td>1.4.0</td><td></td></tr>
|
||||
<tr><td>1.5.0</td><td></td></tr>
|
||||
<tr><td>1.5.1</td><td></td></tr>
|
||||
<tr><td>1.6.0.0</td><td></td></tr>
|
||||
<tr><td>1.6.1.0</td><td><span style="color:blue">latest</span>, <span style="color:green">recommended</span></td></tr>
|
||||
</tbody>
|
||||
</table>
|
||||
</details>
|
||||
|
||||
<details>
|
||||
<summary>Show all supported <a href='https://docs.haskellstack.org/en/stable/README/'>Stack</a> versions</summary>
|
||||
<table>
|
||||
<thead><tr><th>Stack Version</th><th>Tags</th></tr></thead>
|
||||
<tbody>
|
||||
<tr><td>2.5.1</td><td></td></tr>
|
||||
<tr><td>2.7.1</td><td></td></tr>
|
||||
<tr><td>2.7.3</td><td></td></tr>
|
||||
<tr><td>2.7.5</td><td><span style="color:blue">latest</span>, <span style="color:green">recommended</span></td></tr>
|
||||
</tbody>
|
||||
</table>
|
||||
</details>
|
||||
1. [GHC](https://www.haskell.org/ghc/)
|
||||
2. [cabal-install](https://cabal.readthedocs.io/en/latest/)
|
||||
3. [haskell-language-server](https://haskell-language-server.readthedocs.io/en/latest/)
|
||||
4. [stack](https://docs.haskellstack.org/en/latest/README/)
|
||||
|
||||
## Supported platforms
|
||||
|
||||
@@ -168,15 +78,14 @@ May or may not work, several issues:
|
||||
|
||||
Unsupported. GHC may or may not work. Upgrade to WSL2.
|
||||
|
||||
### MacOS <10.13
|
||||
### MacOS <13
|
||||
|
||||
Not supported. Would require separate binaries, since >=10.13 binaries are incompatible.
|
||||
Not supported. Would require separate binaries, since >=13 binaries are incompatible.
|
||||
Please upgrade.
|
||||
|
||||
### MacOS aarch64
|
||||
|
||||
HLS bindists are still experimental. Stack has only unofficial binaries for this platform.
|
||||
There are various issues with GHC itself.
|
||||
HLS bindists are still experimental. Stack is theoretically supported, but has no binaries yet.
|
||||
|
||||
### FreeBSD
|
||||
|
||||
@@ -185,7 +94,7 @@ HLS bindists are experimental.
|
||||
|
||||
### Linux ARMv7/AARCH64
|
||||
|
||||
Lower availability of bindists. Stack and HLS binaries are experimental.
|
||||
Lower availability of bindists. HLS only has experimental ones. Stack not supported currently.
|
||||
|
||||
## Manual install
|
||||
|
||||
|
||||
37
ghcup.cabal
37
ghcup.cabal
@@ -1,6 +1,6 @@
|
||||
cabal-version: 3.0
|
||||
name: ghcup
|
||||
version: 0.1.17.5
|
||||
version: 0.1.17.4
|
||||
license: LGPL-3.0-only
|
||||
license-file: LICENSE
|
||||
copyright: Julian Ospald 2020
|
||||
@@ -48,13 +48,6 @@ flag no-exe
|
||||
default: False
|
||||
manual: True
|
||||
|
||||
flag disable-upgrade
|
||||
description:
|
||||
Disable upgrade functionality. This is mainly to support brew packagers.
|
||||
|
||||
default: False
|
||||
manual: True
|
||||
|
||||
library
|
||||
exposed-modules:
|
||||
GHCup
|
||||
@@ -65,7 +58,6 @@ library
|
||||
GHCup.Requirements
|
||||
GHCup.Types
|
||||
GHCup.Types.JSON
|
||||
GHCup.Types.JSON.Utils
|
||||
GHCup.Types.Optics
|
||||
GHCup.Utils
|
||||
GHCup.Utils.Dirs
|
||||
@@ -121,7 +113,7 @@ library
|
||||
, haskus-utils-variant ^>=3.2.1
|
||||
, libarchive ^>=3.0.3.0
|
||||
, lzma-static ^>=5.2.5.3
|
||||
, megaparsec >=8.0.0 && <9.3
|
||||
, megaparsec >=8.0.0 && <9.1
|
||||
, mtl ^>=2.2
|
||||
, optics ^>=0.4
|
||||
, os-release ^>=1.0.0
|
||||
@@ -200,10 +192,10 @@ executable ghcup
|
||||
GHCup.OptParse.Nuke
|
||||
GHCup.OptParse.Prefetch
|
||||
GHCup.OptParse.Rm
|
||||
GHCup.OptParse.Run
|
||||
GHCup.OptParse.Set
|
||||
GHCup.OptParse.ToolRequirements
|
||||
GHCup.OptParse.UnSet
|
||||
GHCup.OptParse.Upgrade
|
||||
GHCup.OptParse.Whereis
|
||||
|
||||
hs-source-dirs: app/ghcup
|
||||
@@ -236,23 +228,18 @@ executable ghcup
|
||||
, ghcup
|
||||
, haskus-utils-variant ^>=3.2.1
|
||||
, libarchive ^>=3.0.3.0
|
||||
, megaparsec >=8.0.0 && <9.3
|
||||
, megaparsec >=8.0.0 && <9.1
|
||||
, mtl ^>=2.2
|
||||
, optparse-applicative >=0.15.1.0 && <0.18
|
||||
, optparse-applicative >=0.15.1.0 && <0.17
|
||||
, pretty ^>=1.1.3.1
|
||||
, pretty-terminal ^>=0.1.0.0
|
||||
, process ^>=1.6.11.0
|
||||
, resourcet ^>=1.2.2
|
||||
, safe ^>=0.3.18
|
||||
, safe-exceptions ^>=0.1
|
||||
, tagsoup ^>=0.14
|
||||
, template-haskell >=2.7 && <2.18
|
||||
, temporary ^>=1.3
|
||||
, text ^>=1.2.4.0
|
||||
, unordered-containers ^>=0.2
|
||||
, uri-bytestring ^>=0.3.2.2
|
||||
, utf8-string ^>=1.0
|
||||
, vector ^>=0.12
|
||||
, versions >=4.0.1 && <5.1
|
||||
, yaml-streamly ^>=0.12.0
|
||||
|
||||
@@ -266,23 +253,15 @@ executable ghcup
|
||||
, 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
|
||||
|
||||
else
|
||||
build-depends: unix ^>=2.7
|
||||
|
||||
if flag(no-exe)
|
||||
buildable: False
|
||||
|
||||
if flag(disable-upgrade)
|
||||
cpp-options: -DDISABLE_UPGRADE
|
||||
|
||||
else
|
||||
other-modules: GHCup.OptParse.Upgrade
|
||||
|
||||
test-suite ghcup-test
|
||||
type: exitcode-stdio-1.0
|
||||
main-is: Main.hs
|
||||
@@ -310,9 +289,9 @@ test-suite ghcup-test
|
||||
, base >=4.12 && <5
|
||||
, bytestring ^>=0.10
|
||||
, containers ^>=0.6
|
||||
, generic-arbitrary >=0.1.0 && <0.3
|
||||
, generic-arbitrary ^>=0.1.0
|
||||
, ghcup
|
||||
, hspec >=2.7.10 && <2.10
|
||||
, hspec ^>=2.7.10
|
||||
, hspec-golden-aeson ^>=0.9
|
||||
, QuickCheck ^>=2.14.1
|
||||
, quickcheck-arbitrary-adt ^>=0.3.1.0
|
||||
|
||||
252
lib/GHCup.hs
252
lib/GHCup.hs
@@ -5,8 +5,8 @@
|
||||
{-# LANGUAGE FlexibleInstances #-}
|
||||
{-# LANGUAGE MultiParamTypeClasses #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE QuasiQuotes #-}
|
||||
{-# LANGUAGE TemplateHaskell #-}
|
||||
{-# LANGUAGE QuasiQuotes #-}
|
||||
|
||||
{-|
|
||||
Module : GHCup
|
||||
@@ -301,6 +301,22 @@ installPackedGHC dl msubdir inst ver forceInstall = do
|
||||
liftE $ runBuildAction tmpUnpack
|
||||
(Just inst)
|
||||
(installUnpackedGHC workdir inst ver)
|
||||
where
|
||||
-- | Does basic checks for isolated installs
|
||||
-- Isolated Directory:
|
||||
-- 1. if it doesn't exist -> proceed
|
||||
-- 2. if it exists and is empty -> proceed
|
||||
-- 3. if it exists and is non-empty -> panic and leave the house
|
||||
installDestSanityCheck :: ( MonadIO m
|
||||
, MonadCatch m
|
||||
) =>
|
||||
FilePath ->
|
||||
Excepts '[DirNotEmpty] m ()
|
||||
installDestSanityCheck isoDir = do
|
||||
hideErrorDef [doesNotExistErrorType] () $ do
|
||||
contents <- liftIO $ getDirectoryContentsRecursive isoDir
|
||||
unless (null contents) (throwE $ DirNotEmpty isoDir)
|
||||
|
||||
|
||||
|
||||
-- | Install an unpacked GHC distribution. This only deals with the GHC
|
||||
@@ -566,8 +582,6 @@ installHLSBindist :: ( MonadMask m
|
||||
, TarDirDoesNotExist
|
||||
, ArchiveResult
|
||||
, FileAlreadyExistsError
|
||||
, ProcessError
|
||||
, DirNotEmpty
|
||||
]
|
||||
m
|
||||
()
|
||||
@@ -603,55 +617,26 @@ installHLSBindist dlinfo ver isoFilepath forceInstall = do
|
||||
|
||||
-- the subdir of the archive where we do the work
|
||||
workdir <- maybe (pure tmpUnpack) (liftE . intoSubdir tmpUnpack) (view dlSubdir dlinfo)
|
||||
legacy <- liftIO $ isLegacyHLSBindist workdir
|
||||
|
||||
if
|
||||
| not forceInstall
|
||||
, not legacy
|
||||
, (Just fp) <- isoFilepath -> liftE $ installDestSanityCheck fp
|
||||
| otherwise -> pure ()
|
||||
|
||||
case isoFilepath of
|
||||
Just isoDir -> do
|
||||
lift $ logInfo $ "isolated installing HLS to " <> T.pack isoDir
|
||||
if legacy
|
||||
then liftE $ installHLSUnpackedLegacy workdir isoDir Nothing forceInstall
|
||||
else liftE $ runBuildAction tmpUnpack Nothing $ installHLSUnpacked workdir isoDir ver
|
||||
liftE $ installHLSUnpacked workdir isoDir Nothing forceInstall
|
||||
|
||||
Nothing -> do
|
||||
if legacy
|
||||
then liftE $ installHLSUnpackedLegacy workdir binDir (Just ver) forceInstall
|
||||
else do
|
||||
inst <- ghcupHLSDir ver
|
||||
liftE $ runBuildAction tmpUnpack Nothing $ installHLSUnpacked workdir inst ver
|
||||
liftE $ setHLS ver SetHLS_XYZ Nothing
|
||||
liftE $ installHLSUnpacked workdir binDir (Just ver) forceInstall
|
||||
|
||||
liftE $ installHLSPostInst isoFilepath ver
|
||||
|
||||
isLegacyHLSBindist :: FilePath -- ^ Path to the unpacked hls bindist
|
||||
-> IO Bool
|
||||
isLegacyHLSBindist path = do
|
||||
not <$> doesFileExist (path </> "GNUmakefile")
|
||||
|
||||
-- | Install an unpacked hls distribution.
|
||||
installHLSUnpacked :: (MonadMask m, MonadUnliftIO m, MonadReader env m, MonadFail m, HasLog env, HasDirs env, HasSettings env, MonadCatch m, MonadIO m)
|
||||
=> FilePath -- ^ Path to the unpacked hls bindist (where the executable resides)
|
||||
-> FilePath -- ^ Path to install to
|
||||
-> Version
|
||||
-> Excepts '[ProcessError, CopyError, FileAlreadyExistsError, NotInstalled] m ()
|
||||
installHLSUnpacked path inst _ = do
|
||||
lift $ logInfo "Installing HLS"
|
||||
liftIO $ createDirRecursive' inst
|
||||
lEM $ make ["PREFIX=" <> inst, "install"] (Just path)
|
||||
|
||||
-- | Install an unpacked hls distribution (legacy).
|
||||
installHLSUnpackedLegacy :: (MonadReader env m, MonadFail m, HasLog env, MonadCatch m, MonadIO m)
|
||||
=> FilePath -- ^ Path to the unpacked hls bindist (where the executable resides)
|
||||
-> FilePath -- ^ Path to install to
|
||||
-> Maybe Version -- ^ Nothing for isolated install
|
||||
-> Bool -- ^ is it a force install
|
||||
-> Excepts '[CopyError, FileAlreadyExistsError] m ()
|
||||
installHLSUnpackedLegacy path inst mver' forceInstall = do
|
||||
installHLSUnpacked :: (MonadReader env m, MonadFail m, HasLog env, MonadCatch m, MonadIO m)
|
||||
=> FilePath -- ^ Path to the unpacked hls bindist (where the executable resides)
|
||||
-> FilePath -- ^ Path to install to
|
||||
-> Maybe Version -- ^ Nothing for isolated install
|
||||
-> Bool -- ^ is it a force install
|
||||
-> Excepts '[CopyError, FileAlreadyExistsError] m ()
|
||||
installHLSUnpacked path inst mver' forceInstall = do
|
||||
lift $ logInfo "Installing HLS"
|
||||
liftIO $ createDirRecursive' inst
|
||||
|
||||
@@ -707,7 +692,7 @@ installHLSPostInst isoFilepath ver =
|
||||
-- create symlink if this is the latest version in a regular install
|
||||
hlsVers <- lift $ fmap rights getInstalledHLSs
|
||||
let lInstHLS = headMay . reverse . sort $ hlsVers
|
||||
when (maybe True (ver >=) lInstHLS) $ liftE $ setHLS ver SetHLSOnly Nothing
|
||||
when (maybe True (ver >=) lInstHLS) $ liftE $ setHLS ver
|
||||
|
||||
|
||||
-- | Installs hls binaries @haskell-language-server-\<ghcver\>@
|
||||
@@ -740,8 +725,6 @@ installHLSBin :: ( MonadMask m
|
||||
, TarDirDoesNotExist
|
||||
, ArchiveResult
|
||||
, FileAlreadyExistsError
|
||||
, ProcessError
|
||||
, DirNotEmpty
|
||||
]
|
||||
m
|
||||
()
|
||||
@@ -911,9 +894,9 @@ compileHLS targetHLS ghcs jobs ov isolateDir cabalProject cabalProjectLocal patc
|
||||
case isolateDir of
|
||||
Just isoDir -> do
|
||||
lift $ logInfo $ "isolated installing HLS to " <> T.pack isoDir
|
||||
liftE $ installHLSUnpackedLegacy installDir isoDir Nothing True
|
||||
liftE $ installHLSUnpacked installDir isoDir Nothing True
|
||||
Nothing -> do
|
||||
liftE $ installHLSUnpackedLegacy installDir binDir (Just installVer) True
|
||||
liftE $ installHLSUnpacked installDir binDir (Just installVer) True
|
||||
)
|
||||
|
||||
liftE $ installHLSPostInst isolateDir installVer
|
||||
@@ -1092,29 +1075,22 @@ setGHC :: ( MonadReader env m
|
||||
)
|
||||
=> GHCTargetVersion
|
||||
-> SetGHC
|
||||
-> Maybe FilePath -- if set, signals that we're not operating in ~/.ghcup/bin
|
||||
-- and don't want mess with other versions
|
||||
-> Excepts '[NotInstalled] m GHCTargetVersion
|
||||
setGHC ver sghc mBinDir = do
|
||||
setGHC ver sghc = do
|
||||
let verS = T.unpack $ prettyVer (_tvVersion ver)
|
||||
ghcdir <- lift $ ghcupGHCDir ver
|
||||
|
||||
whenM (lift $ not <$> ghcInstalled ver) (throwE (NotInstalled GHC ver))
|
||||
|
||||
-- symlink destination
|
||||
binDir <- case mBinDir of
|
||||
Just x -> pure x
|
||||
Nothing -> do
|
||||
Dirs {binDir = f} <- lift getDirs
|
||||
pure f
|
||||
Dirs {..} <- lift getDirs
|
||||
|
||||
-- first delete the old symlinks (this fixes compatibility issues
|
||||
-- with old ghcup)
|
||||
when (isNothing mBinDir) $
|
||||
case sghc of
|
||||
SetGHCOnly -> liftE $ rmPlainGHC (_tvTarget ver)
|
||||
SetGHC_XY -> liftE $ rmMajorGHCSymlinks ver
|
||||
SetGHC_XYZ -> liftE $ rmMinorGHCSymlinks ver
|
||||
case sghc of
|
||||
SetGHCOnly -> liftE $ rmPlain (_tvTarget ver)
|
||||
SetGHC_XY -> liftE $ rmMajorSymlinks ver
|
||||
SetGHC_XYZ -> liftE $ rmMinorSymlinks ver
|
||||
|
||||
-- for ghc tools (ghc, ghci, haddock, ...)
|
||||
verfiles <- ghcToolFiles ver
|
||||
@@ -1133,17 +1109,15 @@ setGHC ver sghc mBinDir = do
|
||||
|
||||
-- create symlink
|
||||
forM_ mTargetFile $ \targetFile -> do
|
||||
bindir <- ghcInternalBinDir ver
|
||||
let fullF = binDir </> targetFile <> exeExt
|
||||
fileWithExt = bindir </> file <> exeExt
|
||||
destL <- binarySymLinkDestination binDir fileWithExt
|
||||
fileWithExt = file <> exeExt
|
||||
destL <- lift $ ghcLinkDestination fileWithExt ver
|
||||
lift $ createLink destL fullF
|
||||
|
||||
when (isNothing mBinDir) $ do
|
||||
-- create symlink for share dir
|
||||
when (isNothing . _tvTarget $ ver) $ lift $ symlinkShareDir ghcdir verS
|
||||
-- create symlink for share dir
|
||||
when (isNothing . _tvTarget $ ver) $ lift $ symlinkShareDir ghcdir verS
|
||||
|
||||
when (sghc == SetGHCOnly) $ lift warnAboutHlsCompatibility
|
||||
when (sghc == SetGHCOnly) $ lift warnAboutHlsCompatibility
|
||||
|
||||
pure ver
|
||||
|
||||
@@ -1196,7 +1170,7 @@ unsetGHC :: ( MonadReader env m
|
||||
)
|
||||
=> Maybe Text
|
||||
-> Excepts '[NotInstalled] m ()
|
||||
unsetGHC = rmPlainGHC
|
||||
unsetGHC = rmPlain
|
||||
|
||||
|
||||
-- | Set the @~\/.ghcup\/bin\/cabal@ symlink.
|
||||
@@ -1248,60 +1222,35 @@ setHLS :: ( MonadReader env m
|
||||
, MonadUnliftIO m
|
||||
)
|
||||
=> Version
|
||||
-> SetHLS -- Nothing for legacy
|
||||
-> Maybe FilePath -- if set, signals that we're not operating in ~/.ghcup/bin
|
||||
-- and don't want mess with other versions
|
||||
-> Excepts '[NotInstalled] m ()
|
||||
setHLS ver shls mBinDir = do
|
||||
whenM (lift $ not <$> hlsInstalled ver) (throwE (NotInstalled HLS (GHCTargetVersion Nothing ver)))
|
||||
setHLS ver = do
|
||||
Dirs {..} <- lift getDirs
|
||||
|
||||
-- symlink destination
|
||||
binDir <- case mBinDir of
|
||||
Just x -> pure x
|
||||
Nothing -> do
|
||||
Dirs {binDir = f} <- lift getDirs
|
||||
pure f
|
||||
-- Delete old symlinks, since these might have different ghc versions than the
|
||||
-- selected version, so we could end up with stray or incorrect symlinks.
|
||||
oldSyms <- lift hlsSymlinks
|
||||
forM_ oldSyms $ \f -> do
|
||||
lift $ logDebug $ "rm " <> T.pack (binDir </> f)
|
||||
lift $ rmLink (binDir </> f)
|
||||
|
||||
-- first delete the old symlinks
|
||||
when (isNothing mBinDir) $
|
||||
case shls of
|
||||
-- not for legacy
|
||||
SetHLS_XYZ -> liftE $ rmMinorHLSSymlinks ver
|
||||
-- legacy and new
|
||||
SetHLSOnly -> liftE rmPlainHLS
|
||||
-- set haskell-language-server-<ghcver> symlinks
|
||||
bins <- lift $ hlsServerBinaries ver Nothing
|
||||
when (null bins) $ throwE $ NotInstalled HLS (GHCTargetVersion Nothing ver)
|
||||
|
||||
case shls of
|
||||
-- not for legacy
|
||||
SetHLS_XYZ -> do
|
||||
bins <- lift $ hlsInternalServerScripts ver Nothing
|
||||
forM_ bins $ \f -> do
|
||||
let destL = f
|
||||
let target = (<> exeExt) . head . splitOn "~" $ f
|
||||
lift $ createLink destL (binDir </> target)
|
||||
|
||||
forM_ bins $ \f -> do
|
||||
let fname = takeFileName f
|
||||
destL <- binarySymLinkDestination binDir f
|
||||
let target = if "haskell-language-server-wrapper" `isPrefixOf` fname
|
||||
then fname <> "-" <> T.unpack (prettyVer ver) <> exeExt
|
||||
else fname <> "~" <> T.unpack (prettyVer ver) <> exeExt
|
||||
lift $ createLink destL (binDir </> target)
|
||||
-- set haskell-language-server-wrapper symlink
|
||||
let destL = "haskell-language-server-wrapper-" <> T.unpack (prettyVer ver) <> exeExt
|
||||
let wrapper = binDir </> "haskell-language-server-wrapper" <> exeExt
|
||||
|
||||
-- legacy and new
|
||||
SetHLSOnly -> do
|
||||
-- set haskell-language-server-<ghcver> symlinks
|
||||
bins <- lift $ hlsServerBinaries ver Nothing
|
||||
when (null bins) $ throwE $ NotInstalled HLS (GHCTargetVersion Nothing ver)
|
||||
lift $ createLink destL wrapper
|
||||
|
||||
forM_ bins $ \f -> do
|
||||
let destL = f
|
||||
let target = (<> exeExt) . head . splitOn "~" $ f
|
||||
lift $ createLink destL (binDir </> target)
|
||||
lift warnAboutHlsCompatibility
|
||||
|
||||
-- set haskell-language-server-wrapper symlink
|
||||
let destL = "haskell-language-server-wrapper-" <> T.unpack (prettyVer ver) <> exeExt
|
||||
let wrapper = binDir </> "haskell-language-server-wrapper" <> exeExt
|
||||
|
||||
lift $ createLink destL wrapper
|
||||
|
||||
when (isNothing mBinDir) $
|
||||
lift warnAboutHlsCompatibility
|
||||
pure ()
|
||||
|
||||
|
||||
unsetHLS :: ( MonadMask m
|
||||
@@ -1771,14 +1720,14 @@ rmGHCVer ver = do
|
||||
-- this isn't atomic, order matters
|
||||
when isSetGHC $ do
|
||||
lift $ logInfo "Removing ghc symlinks"
|
||||
liftE $ rmPlainGHC (_tvTarget ver)
|
||||
liftE $ rmPlain (_tvTarget ver)
|
||||
|
||||
lift $ logInfo "Removing ghc-x.y.z symlinks"
|
||||
liftE $ rmMinorGHCSymlinks ver
|
||||
liftE $ rmMinorSymlinks ver
|
||||
|
||||
lift $ logInfo "Removing/rewiring ghc-x.y symlinks"
|
||||
-- first remove
|
||||
handle (\(_ :: ParseError) -> pure ()) $ liftE $ rmMajorGHCSymlinks ver
|
||||
handle (\(_ :: ParseError) -> pure ()) $ liftE $ rmMajorSymlinks ver
|
||||
-- then fix them (e.g. with an earlier version)
|
||||
|
||||
lift $ logInfo $ "Removing directory recursively: " <> T.pack dir
|
||||
@@ -1790,7 +1739,7 @@ rmGHCVer ver = do
|
||||
$ fmap Just
|
||||
$ getMajorMinorV (_tvVersion ver)
|
||||
forM_ v' $ \(mj, mi) -> lift (getGHCForPVP (PVP (fromIntegral mj :| [fromIntegral mi])) (_tvTarget ver))
|
||||
>>= mapM_ (\v -> liftE $ setGHC v SetGHC_XY Nothing)
|
||||
>>= mapM_ (\v -> liftE $ setGHC v SetGHC_XY)
|
||||
|
||||
Dirs {..} <- lift getDirs
|
||||
|
||||
@@ -1845,19 +1794,24 @@ rmHLSVer :: ( MonadMask m
|
||||
rmHLSVer ver = do
|
||||
whenM (lift $ fmap not $ hlsInstalled ver) $ throwE (NotInstalled HLS (GHCTargetVersion Nothing ver))
|
||||
|
||||
isHlsSet <- lift hlsSet
|
||||
isHlsSet <- lift hlsSet
|
||||
|
||||
liftE $ rmMinorHLSSymlinks ver
|
||||
hlsDir <- ghcupHLSDir ver
|
||||
recyclePathForcibly hlsDir
|
||||
Dirs {..} <- lift getDirs
|
||||
|
||||
bins <- lift $ hlsAllBinaries ver
|
||||
forM_ bins $ \f -> lift $ recycleFile (binDir </> f)
|
||||
|
||||
when (Just ver == isHlsSet) $ do
|
||||
-- delete all set symlinks
|
||||
rmPlainHLS
|
||||
oldSyms <- lift hlsSymlinks
|
||||
forM_ oldSyms $ \f -> do
|
||||
let fullF = binDir </> f
|
||||
lift $ logDebug $ "rm " <> T.pack fullF
|
||||
lift $ rmLink fullF
|
||||
-- set latest hls
|
||||
hlsVers <- lift $ fmap rights getInstalledHLSs
|
||||
case headMay . reverse . sort $ hlsVers of
|
||||
Just latestver -> setHLS latestver SetHLSOnly Nothing
|
||||
Just latestver -> setHLS latestver
|
||||
Nothing -> pure ()
|
||||
|
||||
|
||||
@@ -2291,7 +2245,7 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patches aargs buildFlavour hadr
|
||||
Nothing -> do
|
||||
reThrowAll GHCupSetError $ postGHCInstall installVer
|
||||
-- restore
|
||||
when alreadySet $ liftE $ void $ setGHC installVer SetGHCOnly Nothing
|
||||
when alreadySet $ liftE $ void $ setGHC installVer SetGHCOnly
|
||||
|
||||
_ -> pure ()
|
||||
|
||||
@@ -2685,7 +2639,7 @@ postGHCInstall :: ( MonadReader env m
|
||||
=> GHCTargetVersion
|
||||
-> Excepts '[NotInstalled] m ()
|
||||
postGHCInstall ver@GHCTargetVersion {..} = do
|
||||
void $ liftE $ setGHC ver SetGHC_XYZ Nothing
|
||||
void $ liftE $ setGHC ver SetGHC_XYZ
|
||||
|
||||
-- Create ghc-x.y symlinks. This may not be the current
|
||||
-- version, create it regardless.
|
||||
@@ -2694,7 +2648,7 @@ postGHCInstall ver@GHCTargetVersion {..} = do
|
||||
$ fmap Just
|
||||
$ getMajorMinorV _tvVersion
|
||||
forM_ v' $ \(mj, mi) -> lift (getGHCForPVP (PVP (fromIntegral mj :| [fromIntegral mi])) _tvTarget)
|
||||
>>= mapM_ (\v -> liftE $ setGHC v SetGHC_XY Nothing)
|
||||
>>= mapM_ (\v -> liftE $ setGHC v SetGHC_XY)
|
||||
|
||||
|
||||
-- | Reports the binary location of a given tool:
|
||||
@@ -2733,11 +2687,7 @@ whereIsTool tool ver@GHCTargetVersion {..} = do
|
||||
HLS -> do
|
||||
whenM (lift $ fmap not $ hlsInstalled _tvVersion)
|
||||
$ throwE (NotInstalled HLS (GHCTargetVersion Nothing _tvVersion))
|
||||
ifM (lift $ isLegacyHLS _tvVersion)
|
||||
(pure (binDir dirs </> "haskell-language-server-wrapper-" <> T.unpack (prettyVer _tvVersion) <> exeExt))
|
||||
$ do
|
||||
bdir <- lift $ ghcupHLSDir _tvVersion
|
||||
pure (bdir </> "bin" </> "haskell-language-server-wrapper" <> exeExt)
|
||||
pure (binDir dirs </> "haskell-language-server-wrapper-" <> T.unpack (prettyVer _tvVersion) <> exeExt)
|
||||
|
||||
Stack -> do
|
||||
whenM (lift $ fmap not $ stackInstalled _tvVersion)
|
||||
@@ -2755,21 +2705,13 @@ checkIfToolInstalled :: ( MonadIO m
|
||||
Tool ->
|
||||
Version ->
|
||||
m Bool
|
||||
checkIfToolInstalled tool ver = checkIfToolInstalled' tool (mkTVer ver)
|
||||
|
||||
checkIfToolInstalled' :: ( MonadIO m
|
||||
, MonadReader env m
|
||||
, HasDirs env
|
||||
, MonadCatch m) =>
|
||||
Tool ->
|
||||
GHCTargetVersion ->
|
||||
m Bool
|
||||
checkIfToolInstalled' tool ver =
|
||||
checkIfToolInstalled tool ver =
|
||||
case tool of
|
||||
Cabal -> cabalInstalled (_tvVersion ver)
|
||||
HLS -> hlsInstalled (_tvVersion ver)
|
||||
Stack -> stackInstalled (_tvVersion ver)
|
||||
GHC -> ghcInstalled ver
|
||||
Cabal -> cabalInstalled ver
|
||||
HLS -> hlsInstalled ver
|
||||
Stack -> stackInstalled ver
|
||||
GHC -> ghcInstalled $ mkTVer ver
|
||||
_ -> pure False
|
||||
|
||||
throwIfFileAlreadyExists :: ( MonadIO m ) =>
|
||||
@@ -2858,31 +2800,21 @@ rmHLSNoGHC :: ( MonadReader env m
|
||||
, HasLog env
|
||||
, MonadIO m
|
||||
, MonadMask m
|
||||
, MonadFail m
|
||||
, MonadUnliftIO m
|
||||
)
|
||||
=> Excepts '[NotInstalled] m ()
|
||||
=> m ()
|
||||
rmHLSNoGHC = do
|
||||
Dirs {..} <- getDirs
|
||||
ghcs <- fmap rights getInstalledGHCs
|
||||
hlses <- fmap rights getInstalledHLSs
|
||||
forM_ hlses $ \hls -> do
|
||||
hlsGHCs <- fmap mkTVer <$> hlsGHCVersions' hls
|
||||
let candidates = filter (`notElem` ghcs) hlsGHCs
|
||||
if (length hlsGHCs - length candidates) <= 0
|
||||
then rmHLSVer hls
|
||||
else
|
||||
forM_ candidates $ \ghc -> do
|
||||
bins1 <- fmap (binDir </>) <$> hlsServerBinaries hls (Just $ _tvVersion ghc)
|
||||
bins2 <- ifM (isLegacyHLS hls) (pure []) $ do
|
||||
shs <- hlsInternalServerScripts hls (Just $ _tvVersion ghc)
|
||||
bins <- hlsInternalServerBinaries hls (Just $ _tvVersion ghc)
|
||||
libs <- hlsInternalServerLibs hls (_tvVersion ghc)
|
||||
pure (shs ++ bins ++ libs)
|
||||
forM_ (bins1 ++ bins2) $ \f -> do
|
||||
forM_ hlsGHCs $ \ghc -> do
|
||||
when (ghc `notElem` ghcs) $ do
|
||||
bins <- hlsServerBinaries hls (Just $ _tvVersion ghc)
|
||||
forM_ bins $ \bin -> do
|
||||
let f = binDir </> bin
|
||||
logDebug $ "rm " <> T.pack f
|
||||
rmFile f
|
||||
pure ()
|
||||
|
||||
|
||||
rmCache :: ( MonadReader env m
|
||||
|
||||
@@ -121,25 +121,28 @@ getDownloadsF = do
|
||||
Settings { urlSource } <- lift getSettings
|
||||
case urlSource of
|
||||
GHCupURL -> liftE $ getBase ghcupURL
|
||||
(OwnSource exts) -> do
|
||||
ext <- liftE $ mapM (either pure getBase) exts
|
||||
mergeGhcupInfo ext
|
||||
(OwnSource url) -> liftE $ getBase url
|
||||
(OwnSpec av) -> pure av
|
||||
(AddSource exts) -> do
|
||||
(AddSource (Left ext)) -> do
|
||||
base <- liftE $ getBase ghcupURL
|
||||
ext <- liftE $ mapM (either pure getBase) exts
|
||||
mergeGhcupInfo (base:ext)
|
||||
pure (mergeGhcupInfo base ext)
|
||||
(AddSource (Right uri)) -> do
|
||||
base <- liftE $ getBase ghcupURL
|
||||
ext <- liftE $ getBase uri
|
||||
pure (mergeGhcupInfo base ext)
|
||||
|
||||
where
|
||||
mergeGhcupInfo :: MonadFail m
|
||||
=> [GHCupInfo]
|
||||
-> m GHCupInfo
|
||||
mergeGhcupInfo [] = fail "mergeGhcupInfo: internal error: need at least one GHCupInfo"
|
||||
mergeGhcupInfo xs@(GHCupInfo{}: _) =
|
||||
let newDownloads = M.unionsWith (M.unionWith (\_ b2 -> b2)) (_ghcupDownloads <$> xs)
|
||||
newGlobalTools = M.unionsWith (\_ a2 -> a2 ) (_globalTools <$> xs)
|
||||
newToolReqs = M.unionsWith (M.unionWith (\_ b2 -> b2)) (_toolRequirements <$> xs)
|
||||
in pure $ GHCupInfo newToolReqs newDownloads newGlobalTools
|
||||
where
|
||||
|
||||
mergeGhcupInfo :: GHCupInfo -- ^ base to merge with
|
||||
-> GHCupInfo -- ^ extension overwriting the base
|
||||
-> GHCupInfo
|
||||
mergeGhcupInfo (GHCupInfo tr base base2) (GHCupInfo _ ext ext2) =
|
||||
let newDownloads = M.mapWithKey (\k a -> case M.lookup k ext of
|
||||
Just a' -> M.union a' a
|
||||
Nothing -> a
|
||||
) base
|
||||
newGlobalTools = M.union base2 ext2
|
||||
in GHCupInfo tr newDownloads newGlobalTools
|
||||
|
||||
|
||||
yamlFromCache :: (MonadReader env m, HasDirs env) => URI -> m FilePath
|
||||
|
||||
@@ -4,7 +4,7 @@
|
||||
{-# LANGUAGE FlexibleInstances #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE QuasiQuotes #-}
|
||||
{-# LANGUAGE TemplateHaskellQuotes #-}
|
||||
{-# LANGUAGE TemplateHaskell #-}
|
||||
|
||||
|
||||
{-|
|
||||
|
||||
@@ -6,7 +6,6 @@
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE FlexibleContexts #-}
|
||||
{-# LANGUAGE FlexibleInstances #-}
|
||||
{-# LANGUAGE TemplateHaskell #-}
|
||||
{-# LANGUAGE DuplicateRecordFields #-}
|
||||
|
||||
{-|
|
||||
@@ -31,15 +30,12 @@ import Data.Map.Strict ( Map )
|
||||
import Data.List.NonEmpty ( NonEmpty (..) )
|
||||
import Data.Text ( Text )
|
||||
import Data.Versions
|
||||
import GHC.IO.Exception ( ExitCode )
|
||||
import Optics ( makeLenses )
|
||||
import Text.PrettyPrint.HughesPJClass (Pretty, pPrint, text, (<+>))
|
||||
import Text.PrettyPrint.HughesPJClass (Pretty, pPrint, text)
|
||||
import URI.ByteString
|
||||
#if defined(BRICK)
|
||||
import Graphics.Vty ( Key(..) )
|
||||
#endif
|
||||
|
||||
import qualified Data.ByteString.Lazy as BL
|
||||
import qualified Data.Text as T
|
||||
import qualified GHC.Generics as GHC
|
||||
|
||||
@@ -286,9 +282,9 @@ instance Pretty TarDir where
|
||||
|
||||
-- | Where to fetch GHCupDownloads from.
|
||||
data URLSource = GHCupURL
|
||||
| OwnSource [Either GHCupInfo URI] -- ^ complete source list
|
||||
| OwnSource URI
|
||||
| OwnSpec GHCupInfo
|
||||
| AddSource [Either GHCupInfo URI] -- ^ merge with GHCupURL
|
||||
| AddSource (Either GHCupInfo URI) -- ^ merge with GHCupURL
|
||||
deriving (GHC.Generic, Show)
|
||||
|
||||
instance NFData URLSource
|
||||
@@ -488,10 +484,6 @@ data SetGHC = SetGHCOnly -- ^ unversioned 'ghc'
|
||||
| SetGHC_XYZ -- ^ ghc-x.y.z
|
||||
deriving (Eq, Show)
|
||||
|
||||
data SetHLS = SetHLSOnly -- ^ unversioned 'hls'
|
||||
| SetHLS_XYZ -- ^ haskell-language-server-a.b.c~x.y.z, where a.b.c is GHC version and x.y.z is HLS version
|
||||
deriving (Eq, Show)
|
||||
|
||||
|
||||
data PlatformResult = PlatformResult
|
||||
{ _platform :: Platform
|
||||
@@ -604,27 +596,3 @@ data LoggerConfig = LoggerConfig
|
||||
|
||||
instance NFData LoggerConfig where
|
||||
rnf (LoggerConfig !lcPrintDebug !_ !_ !fancyColors) = rnf (lcPrintDebug, fancyColors)
|
||||
|
||||
data ProcessError = NonZeroExit Int FilePath [String]
|
||||
| PTerminated FilePath [String]
|
||||
| PStopped FilePath [String]
|
||||
| NoSuchPid FilePath [String]
|
||||
deriving Show
|
||||
|
||||
instance Pretty ProcessError where
|
||||
pPrint (NonZeroExit e exe args) =
|
||||
text "Process" <+> pPrint exe <+> text "with arguments" <+> pPrint args <+> text "failed with exit code" <+> text (show e <> ".")
|
||||
pPrint (PTerminated exe args) =
|
||||
text "Process" <+> pPrint exe <+> text "with arguments" <+> pPrint args <+> text "terminated."
|
||||
pPrint (PStopped exe args) =
|
||||
text "Process" <+> pPrint exe <+> text "with arguments" <+> pPrint args <+> text "stopped."
|
||||
pPrint (NoSuchPid exe args) =
|
||||
text "Could not find PID for process running " <+> pPrint exe <+> text " with arguments " <+> text (show args) <+> text "."
|
||||
data CapturedProcess = CapturedProcess
|
||||
{ _exitCode :: ExitCode
|
||||
, _stdOut :: BL.ByteString
|
||||
, _stdErr :: BL.ByteString
|
||||
}
|
||||
deriving (Eq, Show)
|
||||
|
||||
makeLenses ''CapturedProcess
|
||||
|
||||
@@ -22,8 +22,10 @@ Portability : portable
|
||||
module GHCup.Types.JSON where
|
||||
|
||||
import GHCup.Types
|
||||
import GHCup.Types.JSON.Utils
|
||||
import GHCup.Utils.MegaParsec
|
||||
import GHCup.Utils.Prelude
|
||||
import GHCup.Utils.Logger () -- TH is broken shite and needs GHCup.Utils.Logger for linking, although we don't depend on the file.
|
||||
-- This is due to the boot file.
|
||||
|
||||
import Control.Applicative ( (<|>) )
|
||||
import Data.Aeson hiding (Key)
|
||||
@@ -38,7 +40,6 @@ import Text.Casing
|
||||
|
||||
import qualified Data.List.NonEmpty as NE
|
||||
import qualified Data.Text as T
|
||||
import qualified Data.Text.Encoding.Error as E
|
||||
import qualified Text.Megaparsec as MP
|
||||
import qualified Text.Megaparsec.Char as MPC
|
||||
|
||||
@@ -77,39 +78,7 @@ instance FromJSON Tag where
|
||||
x -> pure (UnknownTag x)
|
||||
|
||||
instance ToJSON URI where
|
||||
toJSON = toJSON . E.decodeUtf8With E.lenientDecode . serializeURIRef'
|
||||
|
||||
instance FromJSON URLSource where
|
||||
parseJSON v =
|
||||
parseGHCupURL v
|
||||
<|> parseOwnSourceLegacy v
|
||||
<|> parseOwnSourceNew1 v
|
||||
<|> parseOwnSourceNew2 v
|
||||
<|> parseOwnSpec v
|
||||
<|> legacyParseAddSource v
|
||||
<|> newParseAddSource v
|
||||
where
|
||||
parseOwnSourceLegacy = withObject "URLSource" $ \o -> do
|
||||
r :: URI <- o .: "OwnSource"
|
||||
pure (OwnSource [Right r])
|
||||
parseOwnSourceNew1 = withObject "URLSource" $ \o -> do
|
||||
r :: [URI] <- o .: "OwnSource"
|
||||
pure (OwnSource (fmap Right r))
|
||||
parseOwnSourceNew2 = withObject "URLSource" $ \o -> do
|
||||
r :: [Either GHCupInfo URI] <- o .: "OwnSource"
|
||||
pure (OwnSource r)
|
||||
parseOwnSpec = withObject "URLSource" $ \o -> do
|
||||
r :: GHCupInfo <- o .: "OwnSpec"
|
||||
pure (OwnSpec r)
|
||||
parseGHCupURL = withObject "URLSource" $ \o -> do
|
||||
_ :: [Value] <- o .: "GHCupURL"
|
||||
pure GHCupURL
|
||||
legacyParseAddSource = withObject "URLSource" $ \o -> do
|
||||
r :: Either GHCupInfo URI <- o .: "AddSource"
|
||||
pure (AddSource [r])
|
||||
newParseAddSource = withObject "URLSource" $ \o -> do
|
||||
r :: [Either GHCupInfo URI] <- o .: "AddSource"
|
||||
pure (AddSource r)
|
||||
toJSON = toJSON . decUTF8Safe . serializeURIRef'
|
||||
|
||||
instance FromJSON URI where
|
||||
parseJSON = withText "URL" $ \t ->
|
||||
@@ -346,7 +315,7 @@ deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''Requir
|
||||
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''DownloadInfo
|
||||
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''VersionInfo
|
||||
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''GHCupInfo
|
||||
deriveToJSON defaultOptions { sumEncoding = ObjectWithSingleField } ''URLSource
|
||||
deriveJSON defaultOptions { sumEncoding = ObjectWithSingleField } ''URLSource
|
||||
deriveJSON defaultOptions { sumEncoding = ObjectWithSingleField } ''Key
|
||||
deriveJSON defaultOptions { fieldLabelModifier = \str' -> maybe str' T.unpack . T.stripPrefix (T.pack "k-") . T.pack . kebab $ str' } ''UserKeyBindings
|
||||
deriveJSON defaultOptions { fieldLabelModifier = \str' -> maybe str' T.unpack . T.stripPrefix (T.pack "u-") . T.pack . kebab $ str' } ''UserSettings
|
||||
|
||||
@@ -1,17 +0,0 @@
|
||||
{-|
|
||||
Module : GHCup.Types.JSON.Utils
|
||||
Description : Utils for TH splices
|
||||
Copyright : (c) Julian Ospald, 2020
|
||||
License : LGPL-3.0
|
||||
Maintainer : hasufell@hasufell.de
|
||||
Stability : experimental
|
||||
Portability : portable
|
||||
-}
|
||||
|
||||
module GHCup.Types.JSON.Utils where
|
||||
|
||||
import qualified Data.Text as T
|
||||
|
||||
removeLensFieldLabel :: String -> String
|
||||
removeLensFieldLabel str' =
|
||||
maybe str' T.unpack . T.stripPrefix (T.pack "_") . T.pack $ str'
|
||||
@@ -3,6 +3,7 @@
|
||||
{-# LANGUAGE FlexibleContexts #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE QuasiQuotes #-}
|
||||
{-# LANGUAGE TemplateHaskell #-}
|
||||
{-# LANGUAGE TypeApplications #-}
|
||||
{-# LANGUAGE ViewPatterns #-}
|
||||
|
||||
@@ -124,32 +125,31 @@ import qualified Data.List.NonEmpty as NE
|
||||
------------------------
|
||||
|
||||
|
||||
-- | Create a relative symlink destination for the binary directory,
|
||||
-- given a target toolpath.
|
||||
binarySymLinkDestination :: ( MonadThrow m
|
||||
, MonadIO m
|
||||
)
|
||||
=> FilePath -- ^ binary dir
|
||||
-> FilePath -- ^ the full toolpath
|
||||
-> m FilePath
|
||||
binarySymLinkDestination binDir toolPath = do
|
||||
toolPath' <- liftIO $ canonicalizePath toolPath
|
||||
binDir' <- liftIO $ canonicalizePath binDir
|
||||
pure (relativeSymlink binDir' toolPath')
|
||||
-- | The symlink destination of a ghc tool.
|
||||
ghcLinkDestination :: ( MonadReader env m
|
||||
, HasDirs env
|
||||
, MonadThrow m, MonadIO m)
|
||||
=> FilePath -- ^ the tool, such as 'ghc', 'haddock' etc.
|
||||
-> GHCTargetVersion
|
||||
-> m FilePath
|
||||
ghcLinkDestination tool ver = do
|
||||
Dirs {..} <- getDirs
|
||||
ghcd <- ghcupGHCDir ver
|
||||
pure (relativeSymlink binDir (ghcd </> "bin" </> tool))
|
||||
|
||||
|
||||
-- | Removes the minor GHC symlinks, e.g. ghc-8.6.5.
|
||||
rmMinorGHCSymlinks :: ( MonadReader env m
|
||||
, HasDirs env
|
||||
, MonadIO m
|
||||
, HasLog env
|
||||
, MonadThrow m
|
||||
, MonadFail m
|
||||
, MonadMask m
|
||||
)
|
||||
=> GHCTargetVersion
|
||||
-> Excepts '[NotInstalled] m ()
|
||||
rmMinorGHCSymlinks tv@GHCTargetVersion{..} = do
|
||||
rmMinorSymlinks :: ( MonadReader env m
|
||||
, HasDirs env
|
||||
, MonadIO m
|
||||
, HasLog env
|
||||
, MonadThrow m
|
||||
, MonadFail m
|
||||
, MonadMask m
|
||||
)
|
||||
=> GHCTargetVersion
|
||||
-> Excepts '[NotInstalled] m ()
|
||||
rmMinorSymlinks tv@GHCTargetVersion{..} = do
|
||||
Dirs {..} <- lift getDirs
|
||||
|
||||
files <- liftE $ ghcToolFiles tv
|
||||
@@ -161,17 +161,17 @@ rmMinorGHCSymlinks tv@GHCTargetVersion{..} = do
|
||||
|
||||
|
||||
-- | Removes the set ghc version for the given target, if any.
|
||||
rmPlainGHC :: ( MonadReader env m
|
||||
, HasDirs env
|
||||
, HasLog env
|
||||
, MonadThrow m
|
||||
, MonadFail m
|
||||
, MonadIO m
|
||||
, MonadMask m
|
||||
)
|
||||
=> Maybe Text -- ^ target
|
||||
-> Excepts '[NotInstalled] m ()
|
||||
rmPlainGHC target = do
|
||||
rmPlain :: ( MonadReader env m
|
||||
, HasDirs env
|
||||
, HasLog env
|
||||
, MonadThrow m
|
||||
, MonadFail m
|
||||
, MonadIO m
|
||||
, MonadMask m
|
||||
)
|
||||
=> Maybe Text -- ^ target
|
||||
-> Excepts '[NotInstalled] m ()
|
||||
rmPlain target = do
|
||||
Dirs {..} <- lift getDirs
|
||||
mtv <- lift $ ghcSet target
|
||||
forM_ mtv $ \tv -> do
|
||||
@@ -187,17 +187,17 @@ rmPlainGHC target = do
|
||||
|
||||
|
||||
-- | Remove the major GHC symlink, e.g. ghc-8.6.
|
||||
rmMajorGHCSymlinks :: ( MonadReader env m
|
||||
, HasDirs env
|
||||
, MonadIO m
|
||||
, HasLog env
|
||||
, MonadThrow m
|
||||
, MonadFail m
|
||||
, MonadMask m
|
||||
)
|
||||
=> GHCTargetVersion
|
||||
-> Excepts '[NotInstalled] m ()
|
||||
rmMajorGHCSymlinks tv@GHCTargetVersion{..} = do
|
||||
rmMajorSymlinks :: ( MonadReader env m
|
||||
, HasDirs env
|
||||
, MonadIO m
|
||||
, HasLog env
|
||||
, MonadThrow m
|
||||
, MonadFail m
|
||||
, MonadMask m
|
||||
)
|
||||
=> GHCTargetVersion
|
||||
-> Excepts '[NotInstalled] m ()
|
||||
rmMajorSymlinks tv@GHCTargetVersion{..} = do
|
||||
Dirs {..} <- lift getDirs
|
||||
(mj, mi) <- getMajorMinorV _tvVersion
|
||||
let v' = intToText mj <> "." <> intToText mi
|
||||
@@ -210,62 +210,6 @@ rmMajorGHCSymlinks tv@GHCTargetVersion{..} = do
|
||||
lift $ hideError doesNotExistErrorType $ rmLink fullF
|
||||
|
||||
|
||||
-- | Removes the minor HLS files, e.g. 'haskell-language-server-8.10.7~1.6.1.0'
|
||||
-- and 'haskell-language-server-wrapper-1.6.1.0'.
|
||||
rmMinorHLSSymlinks :: ( MonadReader env m
|
||||
, HasDirs env
|
||||
, MonadIO m
|
||||
, HasLog env
|
||||
, MonadThrow m
|
||||
, MonadFail m
|
||||
, MonadMask m
|
||||
)
|
||||
=> Version
|
||||
-> Excepts '[NotInstalled] m ()
|
||||
rmMinorHLSSymlinks ver = do
|
||||
Dirs {..} <- lift getDirs
|
||||
|
||||
hlsBins <- hlsAllBinaries ver
|
||||
forM_ hlsBins $ \f -> do
|
||||
let fullF = binDir </> f
|
||||
lift $ logDebug ("rm -f " <> T.pack fullF)
|
||||
-- on unix, this may be either a file (legacy) or a symlink
|
||||
-- on windows, this is always a file... hence 'rmFile'
|
||||
-- works consistently across platforms
|
||||
lift $ rmFile fullF
|
||||
|
||||
-- | Removes the set HLS version, if any.
|
||||
rmPlainHLS :: ( MonadReader env m
|
||||
, HasDirs env
|
||||
, HasLog env
|
||||
, MonadThrow m
|
||||
, MonadFail m
|
||||
, MonadIO m
|
||||
, MonadMask m
|
||||
)
|
||||
=> Excepts '[NotInstalled] m ()
|
||||
rmPlainHLS = do
|
||||
Dirs {..} <- lift getDirs
|
||||
|
||||
-- delete 'haskell-language-server-8.10.7'
|
||||
hlsBins <- fmap (filter (\f -> not ("haskell-language-server-wrapper" `isPrefixOf` f) && ('~' `notElem` f)))
|
||||
$ liftIO $ handleIO (\_ -> pure []) $ findFiles
|
||||
binDir
|
||||
(makeRegexOpts compExtended execBlank ([s|^haskell-language-server-.*$|] :: ByteString))
|
||||
forM_ hlsBins $ \f -> do
|
||||
let fullF = binDir </> f
|
||||
lift $ logDebug ("rm -f " <> T.pack fullF)
|
||||
if isWindows
|
||||
then lift $ rmLink fullF
|
||||
else lift $ rmFile fullF
|
||||
|
||||
-- 'haskell-language-server-wrapper'
|
||||
let hlswrapper = binDir </> "haskell-language-server-wrapper" <> exeExt
|
||||
lift $ logDebug ("rm -f " <> T.pack hlswrapper)
|
||||
if isWindows
|
||||
then lift $ hideError doesNotExistErrorType $ rmLink hlswrapper
|
||||
else lift $ hideError doesNotExistErrorType $ rmFile hlswrapper
|
||||
|
||||
|
||||
|
||||
-----------------------------------
|
||||
@@ -409,8 +353,7 @@ cabalSet = do
|
||||
|
||||
|
||||
-- | Get all installed hls, by matching on
|
||||
-- @~\/.ghcup\/bin/haskell-language-server-wrapper-<\hlsver\>@,
|
||||
-- as well as @~\/.ghcup\/hls\/<\hlsver\>@
|
||||
-- @~\/.ghcup\/bin/haskell-language-server-wrapper-<\hlsver\>@.
|
||||
getInstalledHLSs :: (MonadReader env m, HasDirs env, MonadIO m, MonadCatch m)
|
||||
=> m [Either FilePath Version]
|
||||
getInstalledHLSs = do
|
||||
@@ -421,7 +364,7 @@ getInstalledHLSs = do
|
||||
execBlank
|
||||
([s|^haskell-language-server-wrapper-.*$|] :: ByteString)
|
||||
)
|
||||
legacy <- forM bins $ \f ->
|
||||
forM bins $ \f ->
|
||||
case
|
||||
version . T.pack <$> (stripSuffix exeExt =<< stripPrefix "haskell-language-server-wrapper-" f)
|
||||
of
|
||||
@@ -429,14 +372,6 @@ getInstalledHLSs = do
|
||||
Just (Left _) -> pure $ Left f
|
||||
Nothing -> pure $ Left f
|
||||
|
||||
hlsdir <- ghcupHLSBaseDir
|
||||
fs <- liftIO $ hideErrorDef [NoSuchThing] [] $ listDirectory hlsdir
|
||||
new <- forM fs $ \f -> case parseGHCupHLSDir f of
|
||||
Right r -> pure $ Right r
|
||||
Left _ -> pure $ Left f
|
||||
pure (nub (new <> legacy))
|
||||
|
||||
|
||||
-- | Get all installed stacks, by matching on
|
||||
-- @~\/.ghcup\/bin/stack-<\stackver\>@.
|
||||
getInstalledStacks :: (MonadReader env m, HasDirs env, MonadIO m, MonadCatch m)
|
||||
@@ -512,10 +447,6 @@ hlsInstalled ver = do
|
||||
vers <- fmap rights getInstalledHLSs
|
||||
pure $ elem ver vers
|
||||
|
||||
isLegacyHLS :: (MonadIO m, MonadReader env m, HasDirs env, MonadCatch m) => Version -> m Bool
|
||||
isLegacyHLS ver = do
|
||||
bdir <- ghcupHLSDir ver
|
||||
not <$> liftIO (doesDirectoryExist bdir)
|
||||
|
||||
|
||||
-- Return the currently set hls version, if any.
|
||||
@@ -587,7 +518,7 @@ hlsGHCVersions' v' = do
|
||||
pure . sortBy (flip compare) . rights $ vers
|
||||
|
||||
|
||||
-- | Get all server binaries for an hls version from the ~/.ghcup/bin directory, if any.
|
||||
-- | Get all server binaries for an hls version, if any.
|
||||
hlsServerBinaries :: (MonadReader env m, HasDirs env, MonadIO m)
|
||||
=> Version
|
||||
-> Maybe Version -- ^ optional GHC version
|
||||
@@ -608,44 +539,6 @@ hlsServerBinaries ver mghcVer = do
|
||||
)
|
||||
)
|
||||
|
||||
-- | Get all scripts for a hls version from the ~/.ghcup/hls/<ver>/bin directory, if any.
|
||||
-- Returns the full path.
|
||||
hlsInternalServerScripts :: (MonadReader env m, HasDirs env, MonadIO m, MonadThrow m)
|
||||
=> Version
|
||||
-> Maybe Version -- ^ optional GHC version
|
||||
-> m [FilePath]
|
||||
hlsInternalServerScripts ver mghcVer = do
|
||||
dir <- ghcupHLSDir ver
|
||||
let bdir = dir </> "bin"
|
||||
fmap (bdir </>) . filter (\f -> maybe True (\gv -> ("-" <> T.unpack (prettyVer gv)) `isSuffixOf` f) mghcVer)
|
||||
<$> liftIO (listDirectory bdir)
|
||||
|
||||
-- | Get all binaries for a hls version from the ~/.ghcup/hls/<ver>/lib/haskell-language-server-<ver>/bin directory, if any.
|
||||
-- Returns the full path.
|
||||
hlsInternalServerBinaries :: (MonadReader env m, HasDirs env, MonadIO m, MonadThrow m, MonadFail m)
|
||||
=> Version
|
||||
-> Maybe Version -- ^ optional GHC version
|
||||
-> m [FilePath]
|
||||
hlsInternalServerBinaries ver mghcVer = do
|
||||
dir <- ghcupHLSDir ver
|
||||
let regex = makeRegexOpts compExtended execBlank ([s|^haskell-language-server-.*$|] :: ByteString)
|
||||
(Just bdir) <- fmap headMay $ liftIO $ expandFilePath [Left (dir </> "lib"), Right regex, Left "bin"]
|
||||
fmap (bdir </>) . filter (\f -> maybe True (\gv -> ("-" <> T.unpack (prettyVer gv)) `isSuffixOf` f) mghcVer)
|
||||
<$> liftIO (listDirectory bdir)
|
||||
|
||||
-- | Get all libraries for a hls version from the ~/.ghcup/hls/<ver>/lib/haskell-language-server-<ver>/lib/<ghc-ver>/
|
||||
-- directory, if any.
|
||||
-- Returns the full path.
|
||||
hlsInternalServerLibs :: (MonadReader env m, HasDirs env, MonadIO m, MonadThrow m, MonadFail m)
|
||||
=> Version
|
||||
-> Version -- ^ GHC version
|
||||
-> m [FilePath]
|
||||
hlsInternalServerLibs ver ghcVer = do
|
||||
dir <- ghcupHLSDir ver
|
||||
let regex = makeRegexOpts compExtended execBlank ([s|^haskell-language-server-.*$|] :: ByteString)
|
||||
(Just bdir) <- fmap headMay $ liftIO $ expandFilePath [Left (dir </> "lib"), Right regex, Left ("lib" </> T.unpack (prettyVer ghcVer))]
|
||||
fmap (bdir </>) <$> liftIO (listDirectory bdir)
|
||||
|
||||
|
||||
-- | Get the wrapper binary for an hls version, if any.
|
||||
hlsWrapperBinary :: (MonadReader env m, HasDirs env, MonadThrow m, MonadIO m)
|
||||
@@ -676,6 +569,22 @@ hlsAllBinaries ver = do
|
||||
pure (maybeToList wrapper ++ hls)
|
||||
|
||||
|
||||
-- | Get the active symlinks for hls.
|
||||
hlsSymlinks :: (MonadReader env m, HasDirs env, MonadIO m, MonadCatch m) => m [FilePath]
|
||||
hlsSymlinks = do
|
||||
Dirs {..} <- getDirs
|
||||
oldSyms <- liftIO $ handleIO (\_ -> pure []) $ findFiles
|
||||
binDir
|
||||
(makeRegexOpts compExtended
|
||||
execBlank
|
||||
([s|^haskell-language-server-.*$|] :: ByteString)
|
||||
)
|
||||
filterM
|
||||
( liftIO
|
||||
. pathIsLink
|
||||
. (binDir </>)
|
||||
)
|
||||
oldSyms
|
||||
|
||||
|
||||
|
||||
@@ -806,7 +715,7 @@ unpackToDir dfp av = do
|
||||
(untar . GZip.decompress =<< rf av)
|
||||
| ".tar.xz" `isSuffixOf` fn -> do
|
||||
filecontents <- liftE $ rf av
|
||||
let decompressed = Lzma.decompressWith (Lzma.defaultDecompressParams { Lzma.decompressAutoDecoder= True }) filecontents
|
||||
let decompressed = Lzma.decompress filecontents
|
||||
liftE $ untar decompressed
|
||||
| ".tar.bz2" `isSuffixOf` fn ->
|
||||
liftE (untar . BZip.decompress =<< rf av)
|
||||
@@ -835,7 +744,7 @@ getArchiveFiles av = do
|
||||
(entries . GZip.decompress =<< rf av)
|
||||
| ".tar.xz" `isSuffixOf` fn -> do
|
||||
filecontents <- liftE $ rf av
|
||||
let decompressed = Lzma.decompressWith (Lzma.defaultDecompressParams { Lzma.decompressAutoDecoder= True }) filecontents
|
||||
let decompressed = Lzma.decompress filecontents
|
||||
liftE $ entries decompressed
|
||||
| ".tar.bz2" `isSuffixOf` fn ->
|
||||
liftE (entries . BZip.decompress =<< rf av)
|
||||
@@ -900,16 +809,8 @@ getLatestBaseVersion av pvpVer =
|
||||
--[ Other ]--
|
||||
-------------
|
||||
|
||||
-- | Usually @~\/.ghcup\/ghc\/\<ver\>\/bin\/@
|
||||
ghcInternalBinDir :: (MonadReader env m, HasDirs env, MonadThrow m, MonadFail m, MonadIO m)
|
||||
=> GHCTargetVersion
|
||||
-> m FilePath
|
||||
ghcInternalBinDir ver = do
|
||||
ghcdir <- ghcupGHCDir ver
|
||||
pure (ghcdir </> "bin")
|
||||
|
||||
|
||||
-- | Get tool files from @~\/.ghcup\/ghc\/\<ver\>\/bin\/\*@
|
||||
-- | Get tool files from @~\/.ghcup\/bin\/ghc\/\<ver\>\/bin\/\*@
|
||||
-- while ignoring @*-\<ver\>@ symlinks and accounting for cross triple prefix.
|
||||
--
|
||||
-- Returns unversioned relative files without extension, e.g.:
|
||||
@@ -919,10 +820,11 @@ ghcToolFiles :: (MonadReader env m, HasDirs env, MonadThrow m, MonadFail m, Mona
|
||||
=> GHCTargetVersion
|
||||
-> Excepts '[NotInstalled] m [FilePath]
|
||||
ghcToolFiles ver = do
|
||||
bindir <- ghcInternalBinDir ver
|
||||
ghcdir <- lift $ ghcupGHCDir ver
|
||||
let bindir = ghcdir </> "bin"
|
||||
|
||||
-- fail if ghc is not installed
|
||||
whenM (fmap not $ ghcInstalled ver)
|
||||
whenM (fmap not $ liftIO $ doesDirectoryExist ghcdir)
|
||||
(throwE (NotInstalled GHC ver))
|
||||
|
||||
files <- liftIO (listDirectory bindir >>= filterM (doesFileExist . (bindir </>)))
|
||||
@@ -977,28 +879,20 @@ makeOut args workdir = do
|
||||
executeOut mymake args workdir
|
||||
|
||||
|
||||
-- | Try to apply patches in order. The order is determined by
|
||||
-- a quilt series file (in the patch directory) if one exists,
|
||||
-- else the patches are applied in lexicographical order.
|
||||
-- Fails with 'PatchFailed' on first failure.
|
||||
-- | Try to apply patches in order. Fails with 'PatchFailed'
|
||||
-- on first failure.
|
||||
applyPatches :: (MonadReader env m, HasDirs env, HasLog env, MonadIO m)
|
||||
=> FilePath -- ^ dir containing patches
|
||||
-> FilePath -- ^ dir to apply patches in
|
||||
-> Excepts '[PatchFailed] m ()
|
||||
applyPatches pdir ddir = do
|
||||
let lexicographical = (fmap . fmap) (pdir </>) $ sort <$> findFiles
|
||||
pdir
|
||||
(makeRegexOpts compExtended
|
||||
execBlank
|
||||
([s|.+\.(patch|diff)$|] :: ByteString)
|
||||
)
|
||||
let quilt = map (pdir </>) . lines <$> readFile (pdir </> "series")
|
||||
|
||||
patches <- liftIO $ quilt `catchIO` (\e ->
|
||||
if isDoesNotExistError e || isPermissionError e then
|
||||
lexicographical
|
||||
else throwIO e)
|
||||
forM_ patches $ \patch' -> applyPatch patch' ddir
|
||||
patches <- (fmap . fmap) (pdir </>) $ liftIO $ findFiles
|
||||
pdir
|
||||
(makeRegexOpts compExtended
|
||||
execBlank
|
||||
([s|.+\.(patch|diff)$|] :: ByteString)
|
||||
)
|
||||
forM_ (sort patches) $ \patch' -> applyPatch patch' ddir
|
||||
|
||||
|
||||
applyPatch :: (MonadReader env m, HasDirs env, HasLog env, MonadIO m)
|
||||
@@ -1255,19 +1149,3 @@ ensureDirectories (Dirs baseDir binDir cacheDir logsDir confDir trashDir) = do
|
||||
ghcBinaryName :: GHCTargetVersion -> String
|
||||
ghcBinaryName (GHCTargetVersion (Just t) _) = T.unpack (t <> "-ghc" <> T.pack exeExt)
|
||||
ghcBinaryName (GHCTargetVersion Nothing _) = T.unpack ("ghc" <> T.pack exeExt)
|
||||
|
||||
|
||||
-- | Does basic checks for isolated installs
|
||||
-- Isolated Directory:
|
||||
-- 1. if it doesn't exist -> proceed
|
||||
-- 2. if it exists and is empty -> proceed
|
||||
-- 3. if it exists and is non-empty -> panic and leave the house
|
||||
installDestSanityCheck :: ( MonadIO m
|
||||
, MonadCatch m
|
||||
) =>
|
||||
FilePath ->
|
||||
Excepts '[DirNotEmpty] m ()
|
||||
installDestSanityCheck isoDir = do
|
||||
hideErrorDef [doesNotExistErrorType] () $ do
|
||||
contents <- liftIO $ getDirectoryContentsRecursive isoDir
|
||||
unless (null contents) (throwE $ DirNotEmpty isoDir)
|
||||
|
||||
@@ -20,11 +20,8 @@ module GHCup.Utils.Dirs
|
||||
, ghcupCacheDir
|
||||
, ghcupGHCBaseDir
|
||||
, ghcupGHCDir
|
||||
, ghcupHLSBaseDir
|
||||
, ghcupHLSDir
|
||||
, mkGhcupTmpDir
|
||||
, parseGHCupGHCDir
|
||||
, parseGHCupHLSDir
|
||||
, relativeSymlink
|
||||
, withGHCupTmpDir
|
||||
, getConfigFilePath
|
||||
@@ -49,7 +46,6 @@ import Control.Monad.Reader
|
||||
import Control.Monad.Trans.Resource hiding (throwM)
|
||||
import Data.Bifunctor
|
||||
import Data.Maybe
|
||||
import Data.Versions
|
||||
import GHC.IO.Exception ( IOErrorType(NoSuchThing) )
|
||||
import Haskus.Utils.Variant.Excepts
|
||||
import Optics
|
||||
@@ -248,24 +244,6 @@ parseGHCupGHCDir :: MonadThrow m => FilePath -> m GHCTargetVersion
|
||||
parseGHCupGHCDir (T.pack -> fp) =
|
||||
throwEither $ MP.parse ghcTargetVerP "" fp
|
||||
|
||||
parseGHCupHLSDir :: MonadThrow m => FilePath -> m Version
|
||||
parseGHCupHLSDir (T.pack -> fp) =
|
||||
throwEither $ MP.parse version' "" fp
|
||||
|
||||
-- | ~/.ghcup/hls by default, for new-style installs.
|
||||
ghcupHLSBaseDir :: (MonadReader env m, HasDirs env) => m FilePath
|
||||
ghcupHLSBaseDir = do
|
||||
Dirs {..} <- getDirs
|
||||
pure (baseDir </> "hls")
|
||||
|
||||
-- | Gets '~/.ghcup/hls/<hls-ver>' for new-style installs.
|
||||
ghcupHLSDir :: (MonadReader env m, HasDirs env, MonadThrow m)
|
||||
=> Version
|
||||
-> m FilePath
|
||||
ghcupHLSDir ver = do
|
||||
basedir <- ghcupHLSBaseDir
|
||||
let verdir = T.unpack $ prettyVer ver
|
||||
pure (basedir </> verdir)
|
||||
|
||||
mkGhcupTmpDir :: ( MonadReader env m
|
||||
, HasDirs env
|
||||
@@ -335,7 +313,6 @@ useXDG :: IO Bool
|
||||
useXDG = isJust <$> lookupEnv "GHCUP_USE_XDG_DIRS"
|
||||
|
||||
|
||||
-- | Like 'relpath'. Assumes the inputs are resolved in case of symlinks.
|
||||
relativeSymlink :: FilePath -- ^ the path in which to create the symlink
|
||||
-> FilePath -- ^ the symlink destination
|
||||
-> FilePath
|
||||
|
||||
@@ -1,14 +1,11 @@
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE FlexibleContexts #-}
|
||||
{-# LANGUAGE TemplateHaskell #-}
|
||||
{-# LANGUAGE ViewPatterns #-}
|
||||
|
||||
module GHCup.Utils.File.Common (
|
||||
module GHCup.Utils.File.Common
|
||||
, ProcessError(..)
|
||||
, CapturedProcess(..)
|
||||
) where
|
||||
module GHCup.Utils.File.Common where
|
||||
|
||||
import GHCup.Utils.Prelude
|
||||
import GHCup.Types(ProcessError(..), CapturedProcess(..))
|
||||
|
||||
import Control.Monad.Reader
|
||||
import Data.Maybe
|
||||
@@ -16,7 +13,7 @@ import Data.Text ( Text )
|
||||
import Data.Void
|
||||
import GHC.IO.Exception
|
||||
import Optics hiding ((<|), (|>))
|
||||
import System.Directory hiding (findFiles)
|
||||
import System.Directory
|
||||
import System.FilePath
|
||||
import Text.PrettyPrint.HughesPJClass hiding ( (<>) )
|
||||
import Text.Regex.Posix
|
||||
@@ -27,6 +24,33 @@ import qualified Text.Megaparsec as MP
|
||||
|
||||
|
||||
|
||||
data ProcessError = NonZeroExit Int FilePath [String]
|
||||
| PTerminated FilePath [String]
|
||||
| PStopped FilePath [String]
|
||||
| NoSuchPid FilePath [String]
|
||||
deriving Show
|
||||
|
||||
instance Pretty ProcessError where
|
||||
pPrint (NonZeroExit e exe args) =
|
||||
text "Process" <+> pPrint exe <+> text "with arguments" <+> pPrint args <+> text "failed with exit code" <+> text (show e <> ".")
|
||||
pPrint (PTerminated exe args) =
|
||||
text "Process" <+> pPrint exe <+> text "with arguments" <+> pPrint args <+> text "terminated."
|
||||
pPrint (PStopped exe args) =
|
||||
text "Process" <+> pPrint exe <+> text "with arguments" <+> pPrint args <+> text "stopped."
|
||||
pPrint (NoSuchPid exe args) =
|
||||
text "Could not find PID for process running " <+> pPrint exe <+> text " with arguments " <+> text (show args) <+> text "."
|
||||
|
||||
data CapturedProcess = CapturedProcess
|
||||
{ _exitCode :: ExitCode
|
||||
, _stdOut :: BL.ByteString
|
||||
, _stdErr :: BL.ByteString
|
||||
}
|
||||
deriving (Eq, Show)
|
||||
|
||||
makeLenses ''CapturedProcess
|
||||
|
||||
|
||||
|
||||
-- | Search for a file in the search paths.
|
||||
--
|
||||
-- Catches `PermissionDenied` and `NoSuchThing` and returns `Nothing`.
|
||||
@@ -76,21 +100,6 @@ isInPath p = do
|
||||
else pure False
|
||||
|
||||
|
||||
-- | Follows the first match in case of Regex.
|
||||
expandFilePath :: [Either FilePath Regex] -> IO [FilePath]
|
||||
expandFilePath = go ""
|
||||
where
|
||||
go :: FilePath -> [Either FilePath Regex] -> IO [FilePath]
|
||||
go p [] = pure [p]
|
||||
go p (x:xs) = do
|
||||
case x of
|
||||
Left s -> go (p </> s) xs
|
||||
Right regex -> do
|
||||
fps <- findFiles p regex
|
||||
res <- forM fps $ \fp -> go (p </> fp) xs
|
||||
pure $ mconcat res
|
||||
|
||||
|
||||
findFiles :: FilePath -> Regex -> IO [FilePath]
|
||||
findFiles path regex = do
|
||||
contents <- listDirectory path
|
||||
|
||||
@@ -35,7 +35,6 @@ import Data.Sequence ( Seq, (|>) )
|
||||
import Data.List
|
||||
import Data.Word8
|
||||
import GHC.IO.Exception
|
||||
import System.IO ( stderr )
|
||||
import System.IO.Error
|
||||
import System.FilePath
|
||||
import System.Directory
|
||||
@@ -143,14 +142,14 @@ execLogged exe args chdir lfile env = do
|
||||
printToRegion :: Fd -> Fd -> Int -> MVar Bool -> Bool -> IO ()
|
||||
printToRegion fileFd fdIn size pState no_color = do
|
||||
-- init region
|
||||
forM_ [1..size] $ \_ -> BS.hPut stderr "\n"
|
||||
forM_ [1..size] $ \_ -> BS.putStr "\n"
|
||||
|
||||
void $ flip runStateT mempty
|
||||
$ do
|
||||
handle
|
||||
(\(ex :: SomeException) -> do
|
||||
ps <- liftIO $ takeMVar pState
|
||||
when ps (liftIO $ BS.hPut stderr (pos1 <> moveLineUp size <> clearScreen))
|
||||
when ps (liftIO $ BS.putStr (pos1 <> moveLineUp size <> clearScreen))
|
||||
throw ex
|
||||
) $ readTilEOF lineAction fdIn
|
||||
|
||||
@@ -185,7 +184,7 @@ execLogged exe args chdir lfile env = do
|
||||
Just (TP.Window _ w) -> do
|
||||
regs <- get
|
||||
liftIO $ forM_ (Sq.zip regs (Sq.fromList [0..(Sq.length regs - 1)])) $ \(bs, i) -> do
|
||||
BS.hPut stderr
|
||||
BS.putStr
|
||||
. overwriteNthLine (size - i)
|
||||
. trim w
|
||||
. blue
|
||||
|
||||
@@ -196,8 +196,7 @@ execLogged exe args chdir lfile env = do
|
||||
then pure ()
|
||||
else do
|
||||
void $ BS.appendFile logFile some
|
||||
-- subprocess stdout also goes to stderr for logging
|
||||
void $ BS.hPut stderr some
|
||||
void $ BS.hPut stdout some
|
||||
go
|
||||
|
||||
|
||||
|
||||
@@ -1,4 +1,5 @@
|
||||
{-# LANGUAGE FlexibleContexts #-}
|
||||
{-# LANGUAGE QuasiQuotes #-}
|
||||
{-# LANGUAGE DataKinds #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
@@ -17,7 +18,7 @@ module GHCup.Utils.Logger where
|
||||
|
||||
import GHCup.Types
|
||||
import GHCup.Types.Optics
|
||||
import {-# SOURCE #-} GHCup.Utils.File.Common (findFiles)
|
||||
import {-# SOURCE #-} GHCup.Utils.File.Common
|
||||
import GHCup.Utils.String.QQ
|
||||
|
||||
import Control.Exception.Safe
|
||||
|
||||
@@ -1,5 +1,7 @@
|
||||
{-# LANGUAGE FlexibleContexts #-}
|
||||
{-# LANGUAGE QuasiQuotes #-}
|
||||
{-# LANGUAGE DataKinds #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
module GHCup.Utils.Logger where
|
||||
|
||||
|
||||
@@ -30,7 +30,7 @@ where
|
||||
import GHCup.Types
|
||||
import GHCup.Errors
|
||||
import GHCup.Types.Optics
|
||||
import {-# SOURCE #-} GHCup.Utils.Logger (logWarn)
|
||||
import {-# SOURCE #-} GHCup.Utils.Logger
|
||||
#if defined(IS_WINDOWS)
|
||||
import GHCup.Utils.Prelude.Windows
|
||||
#else
|
||||
@@ -308,6 +308,11 @@ intToText :: Integral a => a -> T.Text
|
||||
intToText = TL.toStrict . B.toLazyText . B.decimal
|
||||
|
||||
|
||||
removeLensFieldLabel :: String -> String
|
||||
removeLensFieldLabel str' =
|
||||
maybe str' T.unpack . T.stripPrefix (T.pack "_") . T.pack $ str'
|
||||
|
||||
|
||||
pvpToVersion :: MonadThrow m => PVP -> Text -> m Version
|
||||
pvpToVersion pvp_ rest =
|
||||
either (\_ -> throwM $ ParseError "Couldn't convert PVP to Version") pure . version . (<> rest) . prettyPVP $ pvp_
|
||||
@@ -472,9 +477,7 @@ recyclePathForcibly fp
|
||||
let dest = tmp </> takeFileName fp
|
||||
liftIO (moveFile fp dest)
|
||||
`catch`
|
||||
(\e -> if | isDoesNotExistError e -> pure ()
|
||||
| isPermissionError e {- EXDEV on windows -} -> recover (liftIO $ removePathForcibly fp)
|
||||
| otherwise -> throwIO e)
|
||||
(\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
|
||||
|
||||
@@ -1,4 +1,4 @@
|
||||
{-# LANGUAGE TemplateHaskellQuotes #-}
|
||||
{-# LANGUAGE TemplateHaskell #-}
|
||||
|
||||
{-|
|
||||
Module : GHCup.Utils.String.QQ
|
||||
|
||||
@@ -4,7 +4,7 @@
|
||||
{-# LANGUAGE DeriveLift #-}
|
||||
{-# LANGUAGE FlexibleInstances #-}
|
||||
{-# LANGUAGE StandaloneDeriving #-}
|
||||
{-# LANGUAGE TemplateHaskellQuotes #-}
|
||||
{-# LANGUAGE TemplateHaskell #-}
|
||||
|
||||
|
||||
{-|
|
||||
|
||||
@@ -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://raw.githubusercontent.com/haskell/ghcup-metadata/master/ghcup-0.0.7.yaml|]
|
||||
ghcupURL = [uri|https://raw.githubusercontent.com/haskell/ghcup-metadata/master/ghcup-0.0.6.yaml|]
|
||||
|
||||
-- | The current ghcup version.
|
||||
ghcUpVer :: PVP
|
||||
|
||||
@@ -1,6 +1,6 @@
|
||||
site_name: GHCup
|
||||
site_url: https://www.haskell.org/ghcup
|
||||
site_description: GHCup is an installer for the general purpose language Haskell.
|
||||
site_description: GHCup documentation
|
||||
site_author: GHCup Team
|
||||
site_favicon: haskell_logo.png
|
||||
|
||||
|
||||
@@ -25,7 +25,7 @@
|
||||
|
||||
plat="$(uname -s)"
|
||||
arch=$(uname -m)
|
||||
ghver="0.1.17.5"
|
||||
ghver="0.1.17.4"
|
||||
base_url="https://downloads.haskell.org/~ghcup"
|
||||
|
||||
export GHCUP_SKIP_UPDATE_CHECK=yes
|
||||
@@ -222,7 +222,8 @@ download_ghcup() {
|
||||
if freebsd-version | grep -E '^12.*' ; then
|
||||
freebsd_ver=12
|
||||
elif freebsd-version | grep -E '^13.*' ; then
|
||||
freebsd_ver=13
|
||||
# TODO: missing FreeBSD13 version
|
||||
freebsd_ver=12
|
||||
else
|
||||
die "Unsupported FreeBSD version! Please report a bug at https://gitlab.haskell.org/haskell/ghcup-hs/-/issues"
|
||||
fi
|
||||
@@ -280,20 +281,7 @@ download_ghcup() {
|
||||
|
||||
# we may overwrite this in adjust_bashrc
|
||||
cat <<-EOF > "${GHCUP_DIR}"/env || die "Failed to create env file"
|
||||
case ":\$PATH:" in
|
||||
*:"${GHCUP_BIN}":*)
|
||||
;;
|
||||
*)
|
||||
export PATH="${GHCUP_BIN}:\$PATH"
|
||||
;;
|
||||
esac
|
||||
case ":\$PATH:" in
|
||||
*:"\$HOME/.cabal/bin":*)
|
||||
;;
|
||||
*)
|
||||
export PATH="\$HOME/.cabal/bin:\$PATH"
|
||||
;;
|
||||
esac
|
||||
export PATH="\$HOME/.cabal/bin:${GHCUP_BIN}:\$PATH"
|
||||
EOF
|
||||
|
||||
# shellcheck disable=SC1090
|
||||
@@ -381,38 +369,12 @@ adjust_bashrc() {
|
||||
case $1 in
|
||||
1)
|
||||
cat <<-EOF > "${GHCUP_DIR}"/env || die "Failed to create env file"
|
||||
case ":\$PATH:" in
|
||||
*:"${GHCUP_BIN}":*)
|
||||
;;
|
||||
*)
|
||||
export PATH="${GHCUP_BIN}:\$PATH"
|
||||
;;
|
||||
esac
|
||||
case ":\$PATH:" in
|
||||
*:"\$HOME/.cabal/bin":*)
|
||||
;;
|
||||
*)
|
||||
export PATH="\$HOME/.cabal/bin:\$PATH"
|
||||
;;
|
||||
esac
|
||||
export PATH="\$HOME/.cabal/bin:${GHCUP_BIN}:\$PATH"
|
||||
EOF
|
||||
;;
|
||||
2)
|
||||
cat <<-EOF > "${GHCUP_DIR}"/env || die "Failed to create env file"
|
||||
case ":\$PATH:" in
|
||||
*:"\$HOME/.cabal/bin":*)
|
||||
;;
|
||||
*)
|
||||
export PATH="\$PATH:\$HOME/.cabal/bin"
|
||||
;;
|
||||
esac
|
||||
case ":\$PATH:" in
|
||||
*:"${GHCUP_BIN}":*)
|
||||
;;
|
||||
*)
|
||||
export PATH="\$PATH:${GHCUP_BIN}"
|
||||
;;
|
||||
esac
|
||||
export PATH="\$PATH:\$HOME/.cabal/bin:${GHCUP_BIN}"
|
||||
EOF
|
||||
;;
|
||||
*) ;;
|
||||
@@ -525,7 +487,7 @@ ask_cabal_config_init() {
|
||||
esac
|
||||
done
|
||||
else
|
||||
return 0
|
||||
return 1
|
||||
fi
|
||||
;;
|
||||
esac
|
||||
@@ -543,8 +505,8 @@ do_cabal_config_init() {
|
||||
adjust_cabal_config
|
||||
;;
|
||||
0)
|
||||
warn "Make sure that your global cabal.config references the correct mingw64 paths (extra-prog-path, extra-include-dirs and extra-lib-dirs)."
|
||||
warn "And set the environment variable GHCUP_MSYS2 to the root path of your msys2 installation."
|
||||
echo "Make sure that your global cabal.config references the correct mingw64 paths (extra-prog-path, extra-include-dirs and extra-lib-dirs)."
|
||||
echo "And set the environment variable GHCUP_MSYS2 to the root path of your msys2 installation."
|
||||
sleep 5
|
||||
return ;;
|
||||
*) ;;
|
||||
|
||||
@@ -29,11 +29,11 @@ param (
|
||||
[switch]$InstallStack,
|
||||
# Whether to install hls as well
|
||||
[switch]$InstallHLS,
|
||||
# Specify the install root (default: 'C:\')
|
||||
[string]$InstallDir,
|
||||
# Specify the bootstrap url (default: 'https://www.haskell.org/ghcup/sh/bootstrap-haskell')
|
||||
[string]$BootstrapUrl,
|
||||
[string]$InstallDir,
|
||||
# Instead of installing a new MSys2, use an existing installation
|
||||
[string]$BootstrapUrl,
|
||||
# Specify the install root (default: 'C:\')
|
||||
[string]$ExistingMsys2Dir,
|
||||
# Specify the cabal root directory (default: '$InstallDir\cabal')
|
||||
[string]$CabalDir
|
||||
@@ -403,17 +403,16 @@ if (!(Test-Path -Path ('{0}' -f $MsysDir))) {
|
||||
# Download the archive
|
||||
Print-Msg -msg 'Downloading Msys2 archive...'
|
||||
$archive = 'msys2-x86_64-latest.sfx.exe'
|
||||
$archivePath = ('{0}\{1}' -f ([IO.Path]::GetTempPath()), "$archive")
|
||||
|
||||
if (Get-Command -Name 'curl.exe' -ErrorAction SilentlyContinue) {
|
||||
Exec "curl.exe" '-o' "$archivePath" ('https://repo.msys2.org/distrib/{0}' -f "$archive")
|
||||
Exec "curl.exe" '-o' ('{0}\{1}' -f $env:TEMP, $archive) ('https://repo.msys2.org/distrib/{0}' -f $archive)
|
||||
} else {
|
||||
Get-FileWCSynchronous -url ('https://repo.msys2.org/distrib/{0}' -f $archive) -destinationFolder ([IO.Path]::GetTempPath()) -includeStats
|
||||
Get-FileWCSynchronous -url ('https://repo.msys2.org/distrib/{0}' -f $archive) -destinationFolder "$env:TEMP" -includeStats
|
||||
}
|
||||
|
||||
Print-Msg -msg 'Extracting Msys2 archive...'
|
||||
$null = & "$archivePath" '-y' ('-o{0}' -f $GhcupDir) # Extract
|
||||
Remove-Item -Path "$archivePath"
|
||||
$null = & "$env:TEMP\$archive" '-y' ('-o{0}' -f $GhcupDir) # Extract
|
||||
Remove-Item -Path ('{0}/{1}' -f $env:TEMP, $archive)
|
||||
|
||||
Print-Msg -msg 'Processing MSYS2 bash for first time use...'
|
||||
Exec "$Bash" '-lc' 'exit'
|
||||
|
||||
@@ -1,49 +0,0 @@
|
||||
|
||||
set -eu
|
||||
|
||||
tag=v$1
|
||||
ver=$1
|
||||
|
||||
dest=$2
|
||||
gpg_user=$3
|
||||
|
||||
mkdir -p "${dest}"
|
||||
|
||||
cd "${dest}"
|
||||
|
||||
base_url="https://gitlab.haskell.org/api/v4/projects/618/jobs/artifacts/${tag}/raw"
|
||||
|
||||
curl -f -o "x86_64-apple-darwin-ghcup-${ver}" \
|
||||
"${base_url}/out/x86_64-apple-darwin-ghcup-${ver}?job=release:darwin"
|
||||
|
||||
curl -f -o "aarch64-apple-darwin-ghcup-${ver}" \
|
||||
"${base_url}/out/aarch64-apple-darwin-ghcup-${ver}?job=release:darwin:aarch64"
|
||||
|
||||
curl -f -o "x86_64-freebsd12-ghcup-${ver}" \
|
||||
"${base_url}/out/x86_64-portbld-freebsd-ghcup-${ver}?job=release:freebsd12"
|
||||
|
||||
curl -f -o "x86_64-freebsd13-ghcup-${ver}" \
|
||||
"${base_url}/out/x86_64-portbld-freebsd-ghcup-${ver}?job=release:freebsd13"
|
||||
|
||||
curl -f -o "i386-linux-ghcup-${ver}" \
|
||||
"${base_url}/out/i386-linux-ghcup-${ver}?job=release:linux:32bit"
|
||||
|
||||
curl -f -o "x86_64-linux-ghcup-${ver}" \
|
||||
"${base_url}/out/x86_64-linux-ghcup-${ver}?job=release:linux:64bit"
|
||||
|
||||
curl -f -o "aarch64-linux-ghcup-${ver}" \
|
||||
"${base_url}/out/aarch64-linux-ghcup-${ver}?job=release:linux:aarch64"
|
||||
|
||||
curl -f -o "armv7-linux-ghcup-${ver}" \
|
||||
"${base_url}/out/armv7-linux-ghcup-${ver}?job=release:linux:armv7"
|
||||
|
||||
curl -f -o "x86_64-mingw64-ghcup-${ver}.exe" \
|
||||
"${base_url}/out/x86_64-mingw64-ghcup-${ver}.exe?job=release:windows"
|
||||
|
||||
rm -f *.sig
|
||||
sha256sum *-ghcup-* > SHA256SUMS
|
||||
gpg --detach-sign -u ${gpg_user} SHA256SUMS
|
||||
for f in *-ghcup-* ; do gpg --detach-sign -u ${gpg_user} $f ; done
|
||||
|
||||
|
||||
|
||||
@@ -1,39 +0,0 @@
|
||||
#!/bin/bash
|
||||
|
||||
url=$1
|
||||
ver=$2
|
||||
|
||||
die() {
|
||||
(>&2 printf "%s\\n" "$1")
|
||||
exit 2
|
||||
}
|
||||
|
||||
[ -z $url ] && die "no url set"
|
||||
[ -z $ver ] && die "no version set"
|
||||
|
||||
sftp $url <<EOF
|
||||
cd ghcup
|
||||
|
||||
rm aarch64-apple-darwin-ghcup
|
||||
rm aarch64-linux-ghcup
|
||||
rm armv7-linux-ghcup
|
||||
rm i386-linux-ghcup
|
||||
rm x86_64-apple-darwin-ghcup
|
||||
rm x86_64-linux-ghcup
|
||||
rm x86_64-mingw64-ghcup.exe
|
||||
rm x86_64-freebsd12-ghcup
|
||||
rm x86_64-freebsd13-ghcup
|
||||
|
||||
symlink ${ver}/aarch64-apple-darwin-ghcup-${ver} aarch64-apple-darwin-ghcup
|
||||
symlink ${ver}/aarch64-linux-ghcup-${ver} aarch64-linux-ghcup
|
||||
symlink ${ver}/armv7-linux-ghcup-${ver} armv7-linux-ghcup
|
||||
symlink ${ver}/i386-linux-ghcup-${ver} i386-linux-ghcup
|
||||
symlink ${ver}/x86_64-apple-darwin-ghcup-${ver} x86_64-apple-darwin-ghcup
|
||||
symlink ${ver}/x86_64-freebsd12-ghcup-${ver} x86_64-freebsd12-ghcup
|
||||
symlink ${ver}/x86_64-freebsd13-ghcup-${ver} x86_64-freebsd13-ghcup
|
||||
symlink ${ver}/x86_64-linux-ghcup-${ver} x86_64-linux-ghcup
|
||||
symlink ${ver}/x86_64-mingw64-ghcup-${ver}.exe x86_64-mingw64-ghcup.exe
|
||||
EOF
|
||||
|
||||
curl -X PURGE https://downloads.haskell.org/~ghcup/
|
||||
curl -X PURGE https://downloads.haskell.org/ghcup/
|
||||
@@ -1,47 +0,0 @@
|
||||
#!/bin/bash
|
||||
|
||||
url=$1
|
||||
ver=$2
|
||||
artifacts_dir=$3
|
||||
|
||||
die() {
|
||||
(>&2 printf "%s\\n" "$1")
|
||||
exit 2
|
||||
}
|
||||
|
||||
[ -z $url ] && die "no url set"
|
||||
[ -z $ver ] && die "no version set"
|
||||
[ -z "${artifacts_dir}" ] && die "artifacts_dir not set"
|
||||
[ -e "${artifacts_dir}" ] || die "artifacts_dir \"${artifacts_dir}\" does not exist"
|
||||
|
||||
cd "${artifacts_dir}"
|
||||
|
||||
sftp $url <<EOF
|
||||
cd ghcup
|
||||
|
||||
mkdir ${ver}
|
||||
cd ${ver}
|
||||
put SHA256SUMS
|
||||
put SHA256SUMS.sig
|
||||
put aarch64-apple-darwin-ghcup-${ver}
|
||||
put aarch64-apple-darwin-ghcup-${ver}.sig
|
||||
put aarch64-linux-ghcup-${ver}
|
||||
put aarch64-linux-ghcup-${ver}.sig
|
||||
put armv7-linux-ghcup-${ver}
|
||||
put armv7-linux-ghcup-${ver}.sig
|
||||
put i386-linux-ghcup-${ver}
|
||||
put i386-linux-ghcup-${ver}.sig
|
||||
put x86_64-apple-darwin-ghcup-${ver}
|
||||
put x86_64-apple-darwin-ghcup-${ver}.sig
|
||||
put x86_64-freebsd12-ghcup-${ver}
|
||||
put x86_64-freebsd12-ghcup-${ver}.sig
|
||||
put x86_64-freebsd13-ghcup-${ver}
|
||||
put x86_64-freebsd13-ghcup-${ver}.sig
|
||||
put x86_64-linux-ghcup-${ver}
|
||||
put x86_64-linux-ghcup-${ver}.sig
|
||||
put x86_64-mingw64-ghcup-${ver}.exe
|
||||
put x86_64-mingw64-ghcup-${ver}.exe.sig
|
||||
EOF
|
||||
|
||||
curl -X PURGE https://downloads.haskell.org/~ghcup/${ver}/
|
||||
curl -X PURGE https://downloads.haskell.org/ghcup/${ver}/
|
||||
@@ -1,4 +1,4 @@
|
||||
resolver: lts-18.27
|
||||
resolver: lts-18.12
|
||||
|
||||
packages:
|
||||
- .
|
||||
@@ -16,7 +16,6 @@ extra-deps:
|
||||
- composition-prelude-3.0.0.2@sha256:1ffed216bd28d810fce0b5be83a661e2a892696d73b3f8de5c0f5edb9b5f0090,1216
|
||||
- haskus-utils-data-1.4@sha256:bfa94363b94b14779edd6834fbd59dbb847c3d7b8f48e3844f456ffdc077da4a,1466
|
||||
- haskus-utils-types-1.5.1@sha256:991c472f4e751e2f0d7aab6ad4220ef151d6160876dcf0511bbf876bbd432020,1298
|
||||
- haskus-utils-variant-3.2.1@sha256:791f4cf1e786eb578f4d37aef60986641f84c36e130164321f7d01542584066a,2200
|
||||
- heaps-0.3.6.1@sha256:7928b759ca5180d35722c45948c0bde264229f3c99c1888188a3d9285f13d3d2,1340
|
||||
- hpath-filepath-0.10.4@sha256:e9e44fb5fdbade7f30b5b5451257dbee15b6ef1aae4060034d73008bb3b5d878,1269
|
||||
- hpath-posix-0.13.3@sha256:abe472cf16bccd3a8b8814865ed3551a728fde0f3a2baea2acc03023bec6c565,1615
|
||||
@@ -40,6 +39,11 @@ extra-deps:
|
||||
- xor-0.0.1.0@sha256:f8362b4a68562b9afbcd727ff64c1a303970df3a032e0033d2f4c094c3501df3,2243
|
||||
- yaml-streamly-0.12.0
|
||||
|
||||
- git: https://github.com/hasufell/packages.git
|
||||
commit: cc0b4688f8bb374fa92f17c856949de795b56291
|
||||
subdirs:
|
||||
- haskus-utils-variant
|
||||
|
||||
flags:
|
||||
http-io-streams:
|
||||
brotli: false
|
||||
|
||||
Reference in New Issue
Block a user