Compare commits
14 Commits
v0.1.5-alp
...
v0.1.5
| Author | SHA1 | Date | |
|---|---|---|---|
| a8be2efd85 | |||
| f46700e1cc | |||
| d7a6935a1a | |||
| a1282b2854 | |||
| 34b9ea7d20 | |||
| 0ff7ebb1fd | |||
| f83dcbc430 | |||
| 56e4a6b15f | |||
| ee9b2ec30d | |||
| 640cf1e2c1 | |||
| 56c439d716 | |||
| 1ed6e49a81 | |||
| fad9f83e6a | |||
| 2e28b0d00f |
@@ -161,7 +161,7 @@ release:linux:32bit:
|
||||
before_script:
|
||||
- ./.gitlab/before_script/linux/alpine/install_deps.sh
|
||||
variables:
|
||||
ARTIFACT: "x86_64-linux-ghcup"
|
||||
ARTIFACT: "i386-linux-ghcup"
|
||||
GHC_VERSION: "8.8.3"
|
||||
CABAL_VERSION: "3.2.0.0"
|
||||
|
||||
|
||||
@@ -42,7 +42,8 @@ chmod +x "${GHCUP_INSTALL_BASE_PREFIX}/.ghcup/bin/cabal"
|
||||
|
||||
# utils
|
||||
apk add --no-cache \
|
||||
bash
|
||||
bash \
|
||||
git
|
||||
|
||||
## Package specific
|
||||
apk add --no-cache \
|
||||
|
||||
@@ -3,7 +3,7 @@
|
||||
set -eux
|
||||
|
||||
sudo apt-get update -y
|
||||
sudo apt-get install -y libnuma-dev zlib1g-dev libgmp-dev libgmp10 libssl-dev liblzma-dev
|
||||
sudo apt-get install -y libnuma-dev zlib1g-dev libgmp-dev libgmp10 libssl-dev liblzma-dev git wget
|
||||
|
||||
. "$( cd "$(dirname "$0")" ; pwd -P )/../../ghcup_env"
|
||||
|
||||
|
||||
@@ -10,13 +10,17 @@ ecabal() {
|
||||
cabal --store-dir="$(pwd)"/.store "$@"
|
||||
}
|
||||
|
||||
git describe
|
||||
|
||||
# build
|
||||
ecabal update
|
||||
|
||||
if [ "${OS}" = "LINUX" ] ; then
|
||||
ecabal build -w ghc-${GHC_VERSION} -fcurl --ghc-options='-split-sections -optl-static'
|
||||
ecabal build -w ghc-${GHC_VERSION} --ghc-options='-split-sections -optl-static'
|
||||
elif [ "${OS}" = "FREEBSD" ] ; then
|
||||
ecabal build -w ghc-${GHC_VERSION} --ghc-options='-split-sections'
|
||||
else
|
||||
ecabal build -w ghc-${GHC_VERSION} -fcurl
|
||||
ecabal build -w ghc-${GHC_VERSION}
|
||||
fi
|
||||
|
||||
mkdir out
|
||||
|
||||
@@ -14,15 +14,16 @@ eghcup() {
|
||||
ghcup -v -c -s file://$(pwd)/ghcup-${JSON_VERSION}.json "$@"
|
||||
}
|
||||
|
||||
git describe
|
||||
|
||||
### build
|
||||
|
||||
ecabal update
|
||||
|
||||
if [ "${OS}" = "DARWIN" ] ; then
|
||||
ecabal build -w ghc-${GHC_VERSION} -fcurl
|
||||
else
|
||||
ecabal build -w ghc-${GHC_VERSION}
|
||||
else
|
||||
ecabal build -w ghc-${GHC_VERSION} -finternal-downloader
|
||||
fi
|
||||
|
||||
cp "$(ecabal new-exec --enable-tests --verbose=0 --offline sh -- -c 'command -v ghcup')" .
|
||||
@@ -70,7 +71,11 @@ ghci-$(ghc --numeric-version) --version
|
||||
|
||||
# test installing new ghc doesn't mess with currently set GHC
|
||||
# https://gitlab.haskell.org/haskell/ghcup-hs/issues/7
|
||||
eghcup install 8.4.4
|
||||
if [ "${OS}" = "LINUX" ] ; then
|
||||
eghcup --downloader=wget install 8.4.4
|
||||
else # test wget a bit
|
||||
eghcup install 8.4.4
|
||||
fi
|
||||
[ "$(ghc --numeric-version)" = "${ghc_ver}" ]
|
||||
eghcup set 8.4.4
|
||||
eghcup set 8.4.4
|
||||
|
||||
16
CHANGELOG.md
16
CHANGELOG.md
@@ -1,5 +1,21 @@
|
||||
# Revision history for ghcup
|
||||
|
||||
## 0.1.5 -- 2020-04-30
|
||||
|
||||
* Fix errors when PATH variable contains path components that are actually files
|
||||
* Add `--version` and `--numeric-version` options
|
||||
* Add `changelog` command
|
||||
* Also check for available GHC and Cabal updates on start
|
||||
* Add base versions as tags for every GHC version (these are "installable" tags and the latest GHC version matching the tag will be picked)
|
||||
* Added `--format-raw` to list subcommand
|
||||
* Allow to install X.Y versions (e.g.: ghcup install 8.8)
|
||||
* Implement `--keep=<always|errors|never>` to control temporary build directories cleanup
|
||||
* Add proper shell completions to the repo
|
||||
* Fix building of documentation
|
||||
* Allow to work in offline mode and use cached files if possible
|
||||
* Allow to set the downloader via `--downloader=<curl|wget>`
|
||||
* Support for compiling and installing a cross GHC (see README). This is experimental.
|
||||
|
||||
## 0.1.4 -- 2020-04-16
|
||||
|
||||
* build on all platforms with curl (as a binary), wrt https://gitlab.haskell.org/haskell/ghcup-hs/issues/6
|
||||
|
||||
19
HACKING.md
19
HACKING.md
@@ -43,3 +43,22 @@ Kazu Yamamoto [explained it in his PR](https://github.com/yesodweb/wai/pull/752#
|
||||
1. Brittany
|
||||
2. mtl-style preferred
|
||||
3. no overly pointfree style
|
||||
|
||||
## Code structure
|
||||
|
||||
Main functionality is in `GHCup` module. Utility functions are
|
||||
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
|
||||
`GHCup.Data.GHCupDownloads`.
|
||||
|
||||
## Major refactors
|
||||
|
||||
1. First major refactor included adding cross support. This added
|
||||
`GHCTargetVersion`, which includes the target in addition to the version.
|
||||
Most of the `Version` parameters to functions had to be replaced with
|
||||
that and ensured the logic is consistent for cross and non-cross
|
||||
installs.
|
||||
|
||||
24
README.md
24
README.md
@@ -11,6 +11,8 @@ Similar in scope to [rustup](https://github.com/rust-lang-nursery/rustup.rs), [p
|
||||
* [Installation](#installation)
|
||||
* [Usage](#usage)
|
||||
* [Manpages](#manpages)
|
||||
* [Shell-completion](#shell-completion)
|
||||
* [Cross support](#cross-support)
|
||||
* [Design goals](#design-goals)
|
||||
* [How](#how)
|
||||
* [Known users](#known-users)
|
||||
@@ -68,11 +70,25 @@ handles your haskell packages and can demand that [a specific version](https://c
|
||||
For man pages to work you need [man-db](http://man-db.nongnu.org/) as your `man` provider, then issue `man ghc`. Manpages only work for the currently set ghc.
|
||||
`MANPATH` may be required to be unset.
|
||||
|
||||
### Bash-completion
|
||||
### Shell-completion
|
||||
|
||||
Depending on your distro and setup, install `.bash-completion` from this repo
|
||||
as e.g. `/etc/bash_completion.d/ghcup` and make sure your bashrc sources the
|
||||
startup script (`/usr/share/bash-completion/bash_completion` on some distros).
|
||||
Shell completions are in `shell-completions`.
|
||||
|
||||
For bash: install `shell-completions/bash`
|
||||
as e.g. `/etc/bash_completion.d/ghcup` (depending on distro)
|
||||
and make sure your bashrc sources the startup script
|
||||
(`/usr/share/bash-completion/bash_completion` on some distros).
|
||||
|
||||
### Cross support
|
||||
|
||||
ghcup can compile and install a cross GHC for any target. However, this
|
||||
requires that the build host has a complete cross toolchain and various
|
||||
libraries installed for the target platform.
|
||||
|
||||
Consult the GHC documentation on the [prerequisites](https://gitlab.haskell.org/ghc/ghc/-/wikis/building/cross-compiling#tools-to-install).
|
||||
For distributions with non-standard locations of cross toolchain and
|
||||
libraries, this may need some tweaking of `build.mk` or configure args.
|
||||
See `ghcup compile ghc --help` for further information.
|
||||
|
||||
## Design goals
|
||||
|
||||
|
||||
@@ -4,8 +4,11 @@
|
||||
|
||||
2. Add/fix downloads to `GHCupDownloads` module, then run `ghcup-gen gen` to generate the new json and validate it via `ghcup-gen check`.
|
||||
|
||||
3. Commit and git push with tag. Wait for tests to succeed.
|
||||
3. Commit and git push with tag. Wait for tests to succeed and release artifacts to build.
|
||||
|
||||
4. Upload the new `ghcup-<ver>.json` to `webhost.haskell.org/ghcup/data/`.
|
||||
4. Download release artifacts and upload them `downloads.haskell.org/ghcup`
|
||||
|
||||
5. Add release artifacts to GHCupDownloads (see point 2.)
|
||||
|
||||
6. Upload the final `ghcup-<ver>.json` to `webhost.haskell.org/ghcup/data/`.
|
||||
|
||||
5. Build ghcup releases for Linux (fully static), mac (with `-fcurl`) and FreeBSD (with `-fcurl`). Upload to `webhost.haskell.org/ghcup/bin/` and update symlinks.
|
||||
|
||||
@@ -179,7 +179,7 @@ validateTarballs dls = do
|
||||
|
||||
where
|
||||
downloadAll dli = do
|
||||
let settings = Settings True False Never
|
||||
let settings = Settings True False Never Curl
|
||||
let runLogger = myLoggerT LoggerConfig { lcPrintDebug = True
|
||||
, colorOutter = B.hPut stderr
|
||||
, rawOutter = (\_ -> pure ())
|
||||
|
||||
@@ -76,6 +76,7 @@ data Options = Options
|
||||
, optUrlSource :: Maybe URI
|
||||
, optNoVerify :: Bool
|
||||
, optKeepDirs :: KeepDirs
|
||||
, optsDownloader :: Downloader
|
||||
-- commands
|
||||
, optCommand :: Command
|
||||
}
|
||||
@@ -181,8 +182,25 @@ opts =
|
||||
( long "keep"
|
||||
<> metavar "<always|errors|never>"
|
||||
<> help
|
||||
"Keep build directories?"
|
||||
"Keep build directories? (default: never)"
|
||||
<> value Never
|
||||
<> hidden
|
||||
)
|
||||
<*> option
|
||||
(eitherReader downloaderParser)
|
||||
( long "downloader"
|
||||
#if defined(INTERNAL_DOWNLOADER)
|
||||
<> metavar "<internal|curl|wget>"
|
||||
<> help
|
||||
"Downloader to use (default: internal)"
|
||||
<> value Internal
|
||||
#else
|
||||
<> metavar "<curl|wget>"
|
||||
<> help
|
||||
"Downloader to use (default: curl)"
|
||||
<> value Curl
|
||||
#endif
|
||||
<> hidden
|
||||
)
|
||||
<*> com
|
||||
where
|
||||
@@ -558,6 +576,16 @@ keepOnParser s' | t == T.pack "always" = Right Always
|
||||
where t = T.toLower (T.pack s')
|
||||
|
||||
|
||||
downloaderParser :: String -> Either String Downloader
|
||||
downloaderParser s' | t == T.pack "curl" = Right Curl
|
||||
| t == T.pack "wget" = Right Wget
|
||||
#if defined(INTERNAL_DOWNLOADER)
|
||||
| t == T.pack "internal" = Right Internal
|
||||
#endif
|
||||
| otherwise = Left ("Unknown downloader value: " <> s')
|
||||
where t = T.toLower (T.pack s')
|
||||
|
||||
|
||||
platformParser :: String -> Either String PlatformRequest
|
||||
platformParser s' = case MP.parse (platformP <* MP.eof) "" (T.pack s') of
|
||||
Right r -> pure r
|
||||
@@ -622,9 +650,10 @@ platformParser s' = case MP.parse (platformP <* MP.eof) "" (T.pack s') of
|
||||
|
||||
toSettings :: Options -> Settings
|
||||
toSettings Options {..} =
|
||||
let cache = optCache
|
||||
noVerify = optNoVerify
|
||||
keepDirs = optKeepDirs
|
||||
let cache = optCache
|
||||
noVerify = optNoVerify
|
||||
keepDirs = optKeepDirs
|
||||
downloader = optsDownloader
|
||||
in Settings { .. }
|
||||
|
||||
|
||||
@@ -812,9 +841,9 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
||||
(GHCupInfo treq dls) <-
|
||||
( runLogger
|
||||
. flip runReaderT settings
|
||||
. runE @'[JSONError , DownloadFailed]
|
||||
. runE @'[JSONError , DownloadFailed, FileDoesNotExistError]
|
||||
$ liftE
|
||||
$ getDownloads (maybe GHCupURL OwnSource optUrlSource)
|
||||
$ getDownloadsF (maybe GHCupURL OwnSource optUrlSource)
|
||||
)
|
||||
>>= \case
|
||||
VRight r -> pure r
|
||||
|
||||
@@ -58,6 +58,33 @@
|
||||
"distroPKGs": [],
|
||||
"notes": "You need the following packages: curl g++ gcc gmp make ncurses realpath xz-utils. Consult your distro documentation on the exact names of those packages."
|
||||
}
|
||||
},
|
||||
"Linux_CentOS": {
|
||||
"7": {
|
||||
"distroPKGs": [
|
||||
"gcc",
|
||||
"gcc-c++",
|
||||
"gmp",
|
||||
"make",
|
||||
"ncurses",
|
||||
"xz",
|
||||
"perl"
|
||||
],
|
||||
"notes": ""
|
||||
},
|
||||
"unknown_versioning": {
|
||||
"distroPKGs": [
|
||||
"gcc",
|
||||
"gcc-c++",
|
||||
"gmp",
|
||||
"make",
|
||||
"ncurses",
|
||||
"ncurses-compat-libs",
|
||||
"xz",
|
||||
"perl"
|
||||
],
|
||||
"notes": ""
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
15
ghcup.cabal
15
ghcup.cabal
@@ -1,6 +1,6 @@
|
||||
cabal-version: 3.0
|
||||
name: ghcup
|
||||
version: 0.1.4
|
||||
version: 0.1.5
|
||||
synopsis: ghc toolchain installer as an exe/library
|
||||
description:
|
||||
A rewrite of the shell script ghcup, for providing
|
||||
@@ -21,8 +21,8 @@ source-repository head
|
||||
type: git
|
||||
location: https://gitlab.haskell.org/haskell/ghcup-hs.git
|
||||
|
||||
flag Curl
|
||||
description: Use curl instead of http-io-streams for download
|
||||
flag internal-downloader
|
||||
description: Compile the internal downloader, which links against OpenSSL
|
||||
default: False
|
||||
manual: True
|
||||
|
||||
@@ -302,15 +302,14 @@ library
|
||||
-- other-extensions:
|
||||
hs-source-dirs: lib
|
||||
|
||||
if !flag(curl)
|
||||
if flag(internal-downloader)
|
||||
import:
|
||||
, HsOpenSSL
|
||||
, http-io-streams
|
||||
, io-streams
|
||||
, terminal-progress-bar
|
||||
exposed-modules: GHCup.Download.IOStreams
|
||||
else
|
||||
cpp-options: -DCURL
|
||||
cpp-options: -DINTERNAL_DOWNLOADER
|
||||
|
||||
executable ghcup
|
||||
import:
|
||||
@@ -345,6 +344,10 @@ executable ghcup
|
||||
hs-source-dirs: app/ghcup
|
||||
default-language: Haskell2010
|
||||
|
||||
if flag(internal-downloader)
|
||||
cpp-options: -DINTERNAL_DOWNLOADER
|
||||
|
||||
|
||||
executable ghcup-gen
|
||||
import:
|
||||
config
|
||||
|
||||
@@ -5,6 +5,7 @@ module GHCup.Data.ToolRequirements where
|
||||
|
||||
import GHCup.Types
|
||||
import GHCup.Utils.String.QQ
|
||||
import GHCup.Utils.Version.QQ
|
||||
|
||||
import qualified Data.Map as M
|
||||
|
||||
@@ -61,6 +62,35 @@ toolRequirements = M.fromList
|
||||
)
|
||||
]
|
||||
)
|
||||
, ( Linux CentOS
|
||||
, M.fromList
|
||||
[ ( Nothing
|
||||
, Requirements
|
||||
[ "gcc"
|
||||
, "gcc-c++"
|
||||
, "gmp"
|
||||
, "make"
|
||||
, "ncurses"
|
||||
, "ncurses-compat-libs"
|
||||
, "xz"
|
||||
, "perl"
|
||||
]
|
||||
""
|
||||
),
|
||||
( Just [vers|7|]
|
||||
, Requirements
|
||||
[ "gcc"
|
||||
, "gcc-c++"
|
||||
, "gmp"
|
||||
, "make"
|
||||
, "ncurses"
|
||||
, "xz"
|
||||
, "perl"
|
||||
]
|
||||
""
|
||||
)
|
||||
]
|
||||
)
|
||||
, ( Darwin
|
||||
, M.fromList
|
||||
[ ( Nothing
|
||||
|
||||
@@ -11,7 +11,7 @@
|
||||
|
||||
module GHCup.Download where
|
||||
|
||||
#if !defined(CURL)
|
||||
#if defined(INTERNAL_DOWNLOADER)
|
||||
import GHCup.Download.IOStreams
|
||||
import GHCup.Download.Utils
|
||||
#endif
|
||||
@@ -35,18 +35,19 @@ import Control.Monad.Reader
|
||||
import Control.Monad.Trans.Resource
|
||||
hiding ( throwM )
|
||||
import Data.Aeson
|
||||
#if !defined(CURL)
|
||||
import Data.ByteString ( ByteString )
|
||||
#if defined(INTERNAL_DOWNLOADER)
|
||||
import Data.CaseInsensitive ( CI )
|
||||
#endif
|
||||
import Data.Maybe
|
||||
import Data.String.Interpolate
|
||||
import Data.Time.Clock
|
||||
import Data.Time.Clock.POSIX
|
||||
#if !defined(CURL)
|
||||
#if defined(INTERNAL_DOWNLOADER)
|
||||
import Data.Time.Format
|
||||
#endif
|
||||
import Data.Versions
|
||||
import Data.Word8
|
||||
import GHC.IO.Exception
|
||||
import HPath
|
||||
import HPath.IO as HIO
|
||||
@@ -57,12 +58,14 @@ import Prelude hiding ( abs
|
||||
, writeFile
|
||||
)
|
||||
import System.IO.Error
|
||||
import System.Posix.Env.ByteString ( getEnv )
|
||||
import URI.ByteString
|
||||
|
||||
import qualified Crypto.Hash.SHA256 as SHA256
|
||||
import qualified Data.ByteString as BS
|
||||
import qualified Data.ByteString.Base16 as B16
|
||||
import qualified Data.ByteString.Lazy as L
|
||||
#if !defined(CURL)
|
||||
#if defined(INTERNAL_DOWNLOADER)
|
||||
import qualified Data.CaseInsensitive as CI
|
||||
import qualified Data.Map.Strict as M
|
||||
import qualified Data.Text as T
|
||||
@@ -82,6 +85,48 @@ import qualified System.Posix.RawFilePath.Directory
|
||||
------------------
|
||||
|
||||
|
||||
-- | Like 'getDownloads', but tries to fall back to
|
||||
-- cached ~/.ghcup/cache/ghcup-<format-ver>.json
|
||||
getDownloadsF :: ( FromJSONKey Tool
|
||||
, FromJSONKey Version
|
||||
, FromJSON VersionInfo
|
||||
, MonadIO m
|
||||
, MonadCatch m
|
||||
, MonadLogger m
|
||||
, MonadThrow m
|
||||
, MonadFail m
|
||||
, MonadReader Settings m
|
||||
)
|
||||
=> URLSource
|
||||
-> Excepts
|
||||
'[JSONError , DownloadFailed , FileDoesNotExistError]
|
||||
m
|
||||
GHCupInfo
|
||||
getDownloadsF urlSource = do
|
||||
case urlSource of
|
||||
GHCupURL ->
|
||||
liftE
|
||||
$ handleIO (\_ -> readFromCache)
|
||||
$ catchE @_ @'[JSONError , FileDoesNotExistError]
|
||||
(\(DownloadFailed _) -> readFromCache)
|
||||
$ getDownloads urlSource
|
||||
(OwnSource _) -> liftE $ getDownloads urlSource
|
||||
(OwnSpec _) -> liftE $ getDownloads urlSource
|
||||
where
|
||||
readFromCache = do
|
||||
lift $ $(logWarn)
|
||||
[i|Could not get download info, trying cached version (this may not be recent!)|]
|
||||
let path = view pathL' ghcupURL
|
||||
cacheDir <- liftIO $ ghcupCacheDir
|
||||
json_file <- (cacheDir </>) <$> urlBaseName path
|
||||
bs <-
|
||||
handleIO' NoSuchThing
|
||||
(\_ -> throwE $ FileDoesNotExistError (toFilePath json_file))
|
||||
$ liftIO
|
||||
$ readFile json_file
|
||||
lE' JSONDecodeError $ eitherDecode' bs
|
||||
|
||||
|
||||
-- | Downloads the download information! But only if we need to ;P
|
||||
getDownloads :: ( FromJSONKey Tool
|
||||
, FromJSONKey Version
|
||||
@@ -91,6 +136,7 @@ getDownloads :: ( FromJSONKey Tool
|
||||
, MonadLogger m
|
||||
, MonadThrow m
|
||||
, MonadFail m
|
||||
, MonadReader Settings m
|
||||
)
|
||||
=> URLSource
|
||||
-> Excepts '[JSONError , DownloadFailed] m GHCupInfo
|
||||
@@ -116,7 +162,12 @@ getDownloads urlSource = do
|
||||
--
|
||||
-- Always save the local file with the mod time of the remote file.
|
||||
smartDl :: forall m1
|
||||
. (MonadCatch m1, MonadIO m1, MonadFail m1, MonadLogger m1)
|
||||
. ( MonadCatch m1
|
||||
, MonadIO m1
|
||||
, MonadFail m1
|
||||
, MonadLogger m1
|
||||
, MonadReader Settings m1
|
||||
)
|
||||
=> URI
|
||||
-> Excepts
|
||||
'[ FileDoesNotExistError
|
||||
@@ -148,31 +199,38 @@ getDownloads urlSource = do
|
||||
Just modTime -> do
|
||||
fileMod <- liftIO $ getModificationTime json_file
|
||||
if modTime > fileMod
|
||||
then do
|
||||
bs <- liftE $ downloadBS uri'
|
||||
liftIO $ writeFileWithModTime modTime json_file bs
|
||||
pure bs
|
||||
then dlWithMod modTime json_file
|
||||
else liftIO $ readFile json_file
|
||||
Nothing -> do
|
||||
lift $ $(logDebug) [i|Unable to get/parse Last-Modified header|]
|
||||
liftIO $ deleteFile json_file
|
||||
liftE $ downloadBS uri'
|
||||
dlWithoutMod json_file
|
||||
else -- access in less than 5 minutes, re-use file
|
||||
liftIO $ readFile json_file
|
||||
else do
|
||||
liftIO $ createDirIfMissing newDirPerms cacheDir
|
||||
getModTime >>= \case
|
||||
Just modTime -> do
|
||||
bs <- liftE $ downloadBS uri'
|
||||
liftIO $ writeFileWithModTime modTime json_file bs
|
||||
pure bs
|
||||
Just modTime -> dlWithMod modTime json_file
|
||||
Nothing -> do
|
||||
-- although we don't know last-modified, we still save
|
||||
-- it to a file, so we might use it in offline mode
|
||||
lift $ $(logDebug) [i|Unable to get/parse Last-Modified header|]
|
||||
liftE $ downloadBS uri'
|
||||
dlWithoutMod json_file
|
||||
|
||||
where
|
||||
dlWithMod modTime json_file = do
|
||||
bs <- liftE $ downloadBS uri'
|
||||
liftIO $ writeFileWithModTime modTime json_file bs
|
||||
pure bs
|
||||
dlWithoutMod json_file = do
|
||||
bs <- liftE $ downloadBS uri'
|
||||
liftIO $ hideError doesNotExistErrorType $ deleteFile json_file
|
||||
liftIO $ writeFileL json_file (Just newFilePerms) bs
|
||||
liftIO $ setModificationTime json_file (fromIntegral @Int 0)
|
||||
pure bs
|
||||
|
||||
|
||||
getModTime = do
|
||||
#if defined(CURL)
|
||||
#if !defined(INTERNAL_DOWNLOADER)
|
||||
pure Nothing
|
||||
#else
|
||||
headers <-
|
||||
@@ -271,12 +329,19 @@ download dli dest mfn
|
||||
(liftIO $ hideError doesNotExistErrorType $ deleteFile destFile)
|
||||
>> (throwE . DownloadFailed $ e)
|
||||
) $ do
|
||||
#if defined(CURL)
|
||||
liftE $ lEM @_ @'[ProcessError] $ liftIO $ exec "curl" True
|
||||
["-fL", "-o", toFilePath destFile , serializeURIRef' $ view dlUri dli] Nothing Nothing
|
||||
#else
|
||||
(https, host, fullPath, port) <- liftE $ uriToQuadruple (view dlUri dli)
|
||||
liftE $ downloadToFile https host fullPath port destFile
|
||||
lift getDownloader >>= \case
|
||||
Curl -> do
|
||||
o' <- liftIO getCurlOpts
|
||||
liftE $ lEM @_ @'[ProcessError] $ liftIO $ exec "curl" True
|
||||
(o' ++ ["-fL", "-o", toFilePath destFile, serializeURIRef' $ view dlUri dli]) Nothing Nothing
|
||||
Wget -> do
|
||||
o' <- liftIO getWgetOpts
|
||||
liftE $ lEM @_ @'[ProcessError] $ liftIO $ exec "wget" True
|
||||
(o' ++ ["-O", toFilePath destFile , serializeURIRef' $ view dlUri dli]) Nothing Nothing
|
||||
#if defined(INTERNAL_DOWNLOADER)
|
||||
Internal -> do
|
||||
(https, host, fullPath, port) <- liftE $ uriToQuadruple (view dlUri dli)
|
||||
liftE $ downloadToFile https host fullPath port destFile
|
||||
#endif
|
||||
|
||||
liftE $ checkDigest dli destFile
|
||||
@@ -329,7 +394,7 @@ downloadCached dli mfn = do
|
||||
|
||||
|
||||
-- | This is used for downloading the JSON.
|
||||
downloadBS :: (MonadCatch m, MonadIO m)
|
||||
downloadBS :: (MonadReader Settings m, MonadCatch m, MonadIO m, MonadLogger m)
|
||||
=> URI
|
||||
-> Excepts
|
||||
'[ FileDoesNotExistError
|
||||
@@ -356,18 +421,33 @@ downloadBS uri'
|
||||
where
|
||||
scheme = view (uriSchemeL' % schemeBSL') uri'
|
||||
path = view pathL' uri'
|
||||
#if defined(CURL)
|
||||
dl _ = do
|
||||
let exe = [rel|curl|]
|
||||
args = ["-sSfL", serializeURIRef' uri']
|
||||
liftIO (executeOut exe args Nothing) >>= \case
|
||||
CapturedProcess ExitSuccess stdout _ -> do
|
||||
pure $ L.fromStrict stdout
|
||||
CapturedProcess (ExitFailure i') _ _ -> throwE $ NonZeroExit i' (toFilePath exe) args
|
||||
#else
|
||||
#if defined(INTERNAL_DOWNLOADER)
|
||||
dl https = do
|
||||
(_, host', fullPath', port') <- liftE $ uriToQuadruple uri'
|
||||
liftE $ downloadBS' https host' fullPath' port'
|
||||
#else
|
||||
dl _ = do
|
||||
#endif
|
||||
lift $ $(logDebug) [i|downloading: #{serializeURIRef' uri'}|]
|
||||
lift getDownloader >>= \case
|
||||
Curl -> do
|
||||
o' <- liftIO getCurlOpts
|
||||
let exe = [rel|curl|]
|
||||
args = o' ++ ["-sSfL", serializeURIRef' uri']
|
||||
liftIO (executeOut exe args Nothing) >>= \case
|
||||
CapturedProcess ExitSuccess stdout _ -> do
|
||||
pure $ L.fromStrict stdout
|
||||
CapturedProcess (ExitFailure i') _ _ -> throwE $ NonZeroExit i' (toFilePath exe) args
|
||||
Wget -> do
|
||||
o' <- liftIO getWgetOpts
|
||||
let exe = [rel|wget|]
|
||||
args = o' ++ ["-qO-", serializeURIRef' uri']
|
||||
liftIO (executeOut exe args Nothing) >>= \case
|
||||
CapturedProcess ExitSuccess stdout _ -> do
|
||||
pure $ L.fromStrict stdout
|
||||
CapturedProcess (ExitFailure i') _ _ -> throwE $ NonZeroExit i' (toFilePath exe) args
|
||||
#if defined(INTERNAL_DOWNLOADER)
|
||||
Internal -> do
|
||||
(_, host', fullPath', port') <- liftE $ uriToQuadruple uri'
|
||||
liftE $ downloadBS' https host' fullPath' port'
|
||||
#endif
|
||||
|
||||
|
||||
@@ -385,3 +465,19 @@ checkDigest dli file = do
|
||||
let eDigest = view dlHash dli
|
||||
when ((cDigest /= eDigest) && verify) $ throwE (DigestError cDigest eDigest)
|
||||
|
||||
|
||||
-- | Get additional curl args from env. This is an undocumented option.
|
||||
getCurlOpts :: IO [ByteString]
|
||||
getCurlOpts =
|
||||
getEnv "GHCUP_CURL_OPTS" >>= \case
|
||||
Just r -> pure $ BS.split _space r
|
||||
Nothing -> pure []
|
||||
|
||||
|
||||
-- | Get additional wget args from env. This is an undocumented option.
|
||||
getWgetOpts :: IO [ByteString]
|
||||
getWgetOpts =
|
||||
getEnv "GHCUP_WGET_OPTS" >>= \case
|
||||
Just r -> pure $ BS.split _space r
|
||||
Nothing -> pure []
|
||||
|
||||
|
||||
@@ -1,3 +1,4 @@
|
||||
{-# LANGUAGE CPP #-}
|
||||
{-# LANGUAGE DeriveGeneric #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
@@ -141,9 +142,10 @@ data URLSource = GHCupURL
|
||||
|
||||
|
||||
data Settings = Settings
|
||||
{ cache :: Bool
|
||||
, noVerify :: Bool
|
||||
, keepDirs :: KeepDirs
|
||||
{ cache :: Bool
|
||||
, noVerify :: Bool
|
||||
, keepDirs :: KeepDirs
|
||||
, downloader :: Downloader
|
||||
}
|
||||
deriving Show
|
||||
|
||||
@@ -153,6 +155,12 @@ data KeepDirs = Always
|
||||
| Never
|
||||
deriving (Eq, Show, Ord)
|
||||
|
||||
data Downloader = Curl
|
||||
| Wget
|
||||
#if defined(INTERNAL_DOWNLOADER)
|
||||
| Internal
|
||||
#endif
|
||||
deriving (Eq, Show, Ord)
|
||||
|
||||
data DebugInfo = DebugInfo
|
||||
{ diBaseDir :: Path Abs
|
||||
|
||||
@@ -174,6 +174,7 @@ ghcSet mtarget = do
|
||||
ghcBin <- (</> ghc) <$> liftIO ghcupBinDir
|
||||
|
||||
-- link destination is of the form ../ghc/<ver>/bin/ghc
|
||||
-- for old ghcup, it is ../ghc/<ver>/bin/ghc-<ver>
|
||||
liftIO $ handleIO' NoSuchThing (\_ -> pure $ Nothing) $ do
|
||||
link <- readSymbolicLink $ toFilePath ghcBin
|
||||
Just <$> ghcLinkVersion link
|
||||
@@ -193,8 +194,8 @@ ghcSet mtarget = do
|
||||
MP.setInput rest
|
||||
pure x
|
||||
)
|
||||
<* MP.chunk "/bin/"
|
||||
<* ghcTargetBinP "ghc"
|
||||
<* MP.chunk "/"
|
||||
<* MP.takeRest
|
||||
<* MP.eof
|
||||
|
||||
|
||||
@@ -349,6 +350,10 @@ getCache :: MonadReader Settings m => m Bool
|
||||
getCache = ask <&> cache
|
||||
|
||||
|
||||
getDownloader :: MonadReader Settings m => m Downloader
|
||||
getDownloader = ask <&> downloader
|
||||
|
||||
|
||||
|
||||
-------------
|
||||
--[ Other ]--
|
||||
|
||||
@@ -16,7 +16,7 @@ ghcupURL :: URI
|
||||
ghcupURL = [uri|https://www.haskell.org/ghcup/data/ghcup-0.0.2.json|]
|
||||
|
||||
ghcUpVer :: PVP
|
||||
ghcUpVer = [pver|0.1.4|]
|
||||
ghcUpVer = [pver|0.1.5|]
|
||||
|
||||
numericVer :: String
|
||||
numericVer = T.unpack . prettyPVP $ ghcUpVer
|
||||
|
||||
19
shell-completions/fish
Normal file
19
shell-completions/fish
Normal file
@@ -0,0 +1,19 @@
|
||||
function _ghcup
|
||||
set -l cl (commandline --tokenize --current-process)
|
||||
# Hack around fish issue #3934
|
||||
set -l cn (commandline --tokenize --cut-at-cursor --current-process)
|
||||
set -l cn (count $cn)
|
||||
set -l tmpline --bash-completion-enriched --bash-completion-index $cn
|
||||
for arg in $cl
|
||||
set tmpline $tmpline --bash-completion-word $arg
|
||||
end
|
||||
for opt in (ghcup $tmpline)
|
||||
if test -d $opt
|
||||
echo -E "$opt/"
|
||||
else
|
||||
echo -E "$opt"
|
||||
end
|
||||
end
|
||||
end
|
||||
|
||||
complete --no-files --command ghcup --arguments '(_ghcup)'
|
||||
32
shell-completions/zsh
Normal file
32
shell-completions/zsh
Normal file
@@ -0,0 +1,32 @@
|
||||
#compdef ghcup
|
||||
|
||||
local request
|
||||
local completions
|
||||
local word
|
||||
local index=$((CURRENT - 1))
|
||||
|
||||
request=(--bash-completion-enriched --bash-completion-index $index)
|
||||
for arg in ${words[@]}; do
|
||||
request=(${request[@]} --bash-completion-word $arg)
|
||||
done
|
||||
|
||||
IFS=$'\n' completions=($( ghcup "${request[@]}" ))
|
||||
|
||||
for word in $completions; do
|
||||
local -a parts
|
||||
|
||||
# Split the line at a tab if there is one.
|
||||
IFS=$'\t' parts=($( echo $word ))
|
||||
|
||||
if [[ -n $parts[2] ]]; then
|
||||
if [[ $word[1] == "-" ]]; then
|
||||
local desc=("$parts[1] ($parts[2])")
|
||||
compadd -d desc -- $parts[1]
|
||||
else
|
||||
local desc=($(print -f "%-019s -- %s" $parts[1] $parts[2]))
|
||||
compadd -l -d desc -- $parts[1]
|
||||
fi
|
||||
else
|
||||
compadd -f -- $word
|
||||
fi
|
||||
done
|
||||
Reference in New Issue
Block a user