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 |
@@ -42,7 +42,8 @@ chmod +x "${GHCUP_INSTALL_BASE_PREFIX}/.ghcup/bin/cabal"
|
|||||||
|
|
||||||
# utils
|
# utils
|
||||||
apk add --no-cache \
|
apk add --no-cache \
|
||||||
bash
|
bash \
|
||||||
|
git
|
||||||
|
|
||||||
## Package specific
|
## Package specific
|
||||||
apk add --no-cache \
|
apk add --no-cache \
|
||||||
|
|||||||
@@ -3,7 +3,7 @@
|
|||||||
set -eux
|
set -eux
|
||||||
|
|
||||||
sudo apt-get update -y
|
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"
|
. "$( cd "$(dirname "$0")" ; pwd -P )/../../ghcup_env"
|
||||||
|
|
||||||
|
|||||||
@@ -10,15 +10,17 @@ ecabal() {
|
|||||||
cabal --store-dir="$(pwd)"/.store "$@"
|
cabal --store-dir="$(pwd)"/.store "$@"
|
||||||
}
|
}
|
||||||
|
|
||||||
|
git describe
|
||||||
|
|
||||||
# build
|
# build
|
||||||
ecabal update
|
ecabal update
|
||||||
|
|
||||||
if [ "${OS}" = "LINUX" ] ; then
|
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
|
elif [ "${OS}" = "FREEBSD" ] ; then
|
||||||
ecabal build -w ghc-${GHC_VERSION} -fcurl --ghc-options='-split-sections'
|
ecabal build -w ghc-${GHC_VERSION} --ghc-options='-split-sections'
|
||||||
else
|
else
|
||||||
ecabal build -w ghc-${GHC_VERSION} -fcurl
|
ecabal build -w ghc-${GHC_VERSION}
|
||||||
fi
|
fi
|
||||||
|
|
||||||
mkdir out
|
mkdir out
|
||||||
|
|||||||
@@ -14,15 +14,16 @@ eghcup() {
|
|||||||
ghcup -v -c -s file://$(pwd)/ghcup-${JSON_VERSION}.json "$@"
|
ghcup -v -c -s file://$(pwd)/ghcup-${JSON_VERSION}.json "$@"
|
||||||
}
|
}
|
||||||
|
|
||||||
|
git describe
|
||||||
|
|
||||||
### build
|
### build
|
||||||
|
|
||||||
ecabal update
|
ecabal update
|
||||||
|
|
||||||
if [ "${OS}" = "DARWIN" ] ; then
|
if [ "${OS}" = "DARWIN" ] ; then
|
||||||
ecabal build -w ghc-${GHC_VERSION} -fcurl
|
|
||||||
else
|
|
||||||
ecabal build -w ghc-${GHC_VERSION}
|
ecabal build -w ghc-${GHC_VERSION}
|
||||||
|
else
|
||||||
|
ecabal build -w ghc-${GHC_VERSION} -finternal-downloader
|
||||||
fi
|
fi
|
||||||
|
|
||||||
cp "$(ecabal new-exec --enable-tests --verbose=0 --offline sh -- -c 'command -v ghcup')" .
|
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
|
# test installing new ghc doesn't mess with currently set GHC
|
||||||
# https://gitlab.haskell.org/haskell/ghcup-hs/issues/7
|
# 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}" ]
|
[ "$(ghc --numeric-version)" = "${ghc_ver}" ]
|
||||||
eghcup set 8.4.4
|
eghcup set 8.4.4
|
||||||
eghcup set 8.4.4
|
eghcup set 8.4.4
|
||||||
|
|||||||
16
CHANGELOG.md
16
CHANGELOG.md
@@ -1,5 +1,21 @@
|
|||||||
# Revision history for ghcup
|
# 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
|
## 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
|
* 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
|
1. Brittany
|
||||||
2. mtl-style preferred
|
2. mtl-style preferred
|
||||||
3. no overly pointfree style
|
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)
|
* [Installation](#installation)
|
||||||
* [Usage](#usage)
|
* [Usage](#usage)
|
||||||
* [Manpages](#manpages)
|
* [Manpages](#manpages)
|
||||||
|
* [Shell-completion](#shell-completion)
|
||||||
|
* [Cross support](#cross-support)
|
||||||
* [Design goals](#design-goals)
|
* [Design goals](#design-goals)
|
||||||
* [How](#how)
|
* [How](#how)
|
||||||
* [Known users](#known-users)
|
* [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.
|
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.
|
`MANPATH` may be required to be unset.
|
||||||
|
|
||||||
### Bash-completion
|
### Shell-completion
|
||||||
|
|
||||||
Depending on your distro and setup, install `.bash-completion` from this repo
|
Shell completions are in `shell-completions`.
|
||||||
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).
|
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
|
## 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`.
|
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
|
where
|
||||||
downloadAll dli = do
|
downloadAll dli = do
|
||||||
let settings = Settings True False Never
|
let settings = Settings True False Never Curl
|
||||||
let runLogger = myLoggerT LoggerConfig { lcPrintDebug = True
|
let runLogger = myLoggerT LoggerConfig { lcPrintDebug = True
|
||||||
, colorOutter = B.hPut stderr
|
, colorOutter = B.hPut stderr
|
||||||
, rawOutter = (\_ -> pure ())
|
, rawOutter = (\_ -> pure ())
|
||||||
|
|||||||
@@ -76,6 +76,7 @@ data Options = Options
|
|||||||
, optUrlSource :: Maybe URI
|
, optUrlSource :: Maybe URI
|
||||||
, optNoVerify :: Bool
|
, optNoVerify :: Bool
|
||||||
, optKeepDirs :: KeepDirs
|
, optKeepDirs :: KeepDirs
|
||||||
|
, optsDownloader :: Downloader
|
||||||
-- commands
|
-- commands
|
||||||
, optCommand :: Command
|
, optCommand :: Command
|
||||||
}
|
}
|
||||||
@@ -181,8 +182,25 @@ opts =
|
|||||||
( long "keep"
|
( long "keep"
|
||||||
<> metavar "<always|errors|never>"
|
<> metavar "<always|errors|never>"
|
||||||
<> help
|
<> help
|
||||||
"Keep build directories?"
|
"Keep build directories? (default: never)"
|
||||||
<> value 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
|
<*> com
|
||||||
where
|
where
|
||||||
@@ -558,6 +576,16 @@ keepOnParser s' | t == T.pack "always" = Right Always
|
|||||||
where t = T.toLower (T.pack s')
|
where t = T.toLower (T.pack s')
|
||||||
|
|
||||||
|
|
||||||
|
downloaderParser :: String -> Either String Downloader
|
||||||
|
downloaderParser s' | t == T.pack "curl" = Right Curl
|
||||||
|
| t == T.pack "wget" = Right Wget
|
||||||
|
#if defined(INTERNAL_DOWNLOADER)
|
||||||
|
| t == T.pack "internal" = Right Internal
|
||||||
|
#endif
|
||||||
|
| otherwise = Left ("Unknown downloader value: " <> s')
|
||||||
|
where t = T.toLower (T.pack s')
|
||||||
|
|
||||||
|
|
||||||
platformParser :: String -> Either String PlatformRequest
|
platformParser :: String -> Either String PlatformRequest
|
||||||
platformParser s' = case MP.parse (platformP <* MP.eof) "" (T.pack s') of
|
platformParser s' = case MP.parse (platformP <* MP.eof) "" (T.pack s') of
|
||||||
Right r -> pure r
|
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 -> Settings
|
||||||
toSettings Options {..} =
|
toSettings Options {..} =
|
||||||
let cache = optCache
|
let cache = optCache
|
||||||
noVerify = optNoVerify
|
noVerify = optNoVerify
|
||||||
keepDirs = optKeepDirs
|
keepDirs = optKeepDirs
|
||||||
|
downloader = optsDownloader
|
||||||
in Settings { .. }
|
in Settings { .. }
|
||||||
|
|
||||||
|
|
||||||
@@ -812,9 +841,9 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
|||||||
(GHCupInfo treq dls) <-
|
(GHCupInfo treq dls) <-
|
||||||
( runLogger
|
( runLogger
|
||||||
. flip runReaderT settings
|
. flip runReaderT settings
|
||||||
. runE @'[JSONError , DownloadFailed]
|
. runE @'[JSONError , DownloadFailed, FileDoesNotExistError]
|
||||||
$ liftE
|
$ liftE
|
||||||
$ getDownloads (maybe GHCupURL OwnSource optUrlSource)
|
$ getDownloadsF (maybe GHCupURL OwnSource optUrlSource)
|
||||||
)
|
)
|
||||||
>>= \case
|
>>= \case
|
||||||
VRight r -> pure r
|
VRight r -> pure r
|
||||||
|
|||||||
@@ -58,6 +58,33 @@
|
|||||||
"distroPKGs": [],
|
"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."
|
"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
|
cabal-version: 3.0
|
||||||
name: ghcup
|
name: ghcup
|
||||||
version: 0.1.4
|
version: 0.1.5
|
||||||
synopsis: ghc toolchain installer as an exe/library
|
synopsis: ghc toolchain installer as an exe/library
|
||||||
description:
|
description:
|
||||||
A rewrite of the shell script ghcup, for providing
|
A rewrite of the shell script ghcup, for providing
|
||||||
@@ -21,8 +21,8 @@ source-repository head
|
|||||||
type: git
|
type: git
|
||||||
location: https://gitlab.haskell.org/haskell/ghcup-hs.git
|
location: https://gitlab.haskell.org/haskell/ghcup-hs.git
|
||||||
|
|
||||||
flag Curl
|
flag internal-downloader
|
||||||
description: Use curl instead of http-io-streams for download
|
description: Compile the internal downloader, which links against OpenSSL
|
||||||
default: False
|
default: False
|
||||||
manual: True
|
manual: True
|
||||||
|
|
||||||
@@ -302,15 +302,14 @@ library
|
|||||||
-- other-extensions:
|
-- other-extensions:
|
||||||
hs-source-dirs: lib
|
hs-source-dirs: lib
|
||||||
|
|
||||||
if !flag(curl)
|
if flag(internal-downloader)
|
||||||
import:
|
import:
|
||||||
, HsOpenSSL
|
, HsOpenSSL
|
||||||
, http-io-streams
|
, http-io-streams
|
||||||
, io-streams
|
, io-streams
|
||||||
, terminal-progress-bar
|
, terminal-progress-bar
|
||||||
exposed-modules: GHCup.Download.IOStreams
|
exposed-modules: GHCup.Download.IOStreams
|
||||||
else
|
cpp-options: -DINTERNAL_DOWNLOADER
|
||||||
cpp-options: -DCURL
|
|
||||||
|
|
||||||
executable ghcup
|
executable ghcup
|
||||||
import:
|
import:
|
||||||
@@ -345,6 +344,10 @@ executable ghcup
|
|||||||
hs-source-dirs: app/ghcup
|
hs-source-dirs: app/ghcup
|
||||||
default-language: Haskell2010
|
default-language: Haskell2010
|
||||||
|
|
||||||
|
if flag(internal-downloader)
|
||||||
|
cpp-options: -DINTERNAL_DOWNLOADER
|
||||||
|
|
||||||
|
|
||||||
executable ghcup-gen
|
executable ghcup-gen
|
||||||
import:
|
import:
|
||||||
config
|
config
|
||||||
|
|||||||
@@ -5,6 +5,7 @@ module GHCup.Data.ToolRequirements where
|
|||||||
|
|
||||||
import GHCup.Types
|
import GHCup.Types
|
||||||
import GHCup.Utils.String.QQ
|
import GHCup.Utils.String.QQ
|
||||||
|
import GHCup.Utils.Version.QQ
|
||||||
|
|
||||||
import qualified Data.Map as M
|
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
|
, ( Darwin
|
||||||
, M.fromList
|
, M.fromList
|
||||||
[ ( Nothing
|
[ ( Nothing
|
||||||
|
|||||||
@@ -11,7 +11,7 @@
|
|||||||
|
|
||||||
module GHCup.Download where
|
module GHCup.Download where
|
||||||
|
|
||||||
#if !defined(CURL)
|
#if defined(INTERNAL_DOWNLOADER)
|
||||||
import GHCup.Download.IOStreams
|
import GHCup.Download.IOStreams
|
||||||
import GHCup.Download.Utils
|
import GHCup.Download.Utils
|
||||||
#endif
|
#endif
|
||||||
@@ -35,18 +35,19 @@ import Control.Monad.Reader
|
|||||||
import Control.Monad.Trans.Resource
|
import Control.Monad.Trans.Resource
|
||||||
hiding ( throwM )
|
hiding ( throwM )
|
||||||
import Data.Aeson
|
import Data.Aeson
|
||||||
#if !defined(CURL)
|
|
||||||
import Data.ByteString ( ByteString )
|
import Data.ByteString ( ByteString )
|
||||||
|
#if defined(INTERNAL_DOWNLOADER)
|
||||||
import Data.CaseInsensitive ( CI )
|
import Data.CaseInsensitive ( CI )
|
||||||
#endif
|
#endif
|
||||||
import Data.Maybe
|
import Data.Maybe
|
||||||
import Data.String.Interpolate
|
import Data.String.Interpolate
|
||||||
import Data.Time.Clock
|
import Data.Time.Clock
|
||||||
import Data.Time.Clock.POSIX
|
import Data.Time.Clock.POSIX
|
||||||
#if !defined(CURL)
|
#if defined(INTERNAL_DOWNLOADER)
|
||||||
import Data.Time.Format
|
import Data.Time.Format
|
||||||
#endif
|
#endif
|
||||||
import Data.Versions
|
import Data.Versions
|
||||||
|
import Data.Word8
|
||||||
import GHC.IO.Exception
|
import GHC.IO.Exception
|
||||||
import HPath
|
import HPath
|
||||||
import HPath.IO as HIO
|
import HPath.IO as HIO
|
||||||
@@ -57,12 +58,14 @@ import Prelude hiding ( abs
|
|||||||
, writeFile
|
, writeFile
|
||||||
)
|
)
|
||||||
import System.IO.Error
|
import System.IO.Error
|
||||||
|
import System.Posix.Env.ByteString ( getEnv )
|
||||||
import URI.ByteString
|
import URI.ByteString
|
||||||
|
|
||||||
import qualified Crypto.Hash.SHA256 as SHA256
|
import qualified Crypto.Hash.SHA256 as SHA256
|
||||||
|
import qualified Data.ByteString as BS
|
||||||
import qualified Data.ByteString.Base16 as B16
|
import qualified Data.ByteString.Base16 as B16
|
||||||
import qualified Data.ByteString.Lazy as L
|
import qualified Data.ByteString.Lazy as L
|
||||||
#if !defined(CURL)
|
#if defined(INTERNAL_DOWNLOADER)
|
||||||
import qualified Data.CaseInsensitive as CI
|
import qualified Data.CaseInsensitive as CI
|
||||||
import qualified Data.Map.Strict as M
|
import qualified Data.Map.Strict as M
|
||||||
import qualified Data.Text as T
|
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
|
-- | Downloads the download information! But only if we need to ;P
|
||||||
getDownloads :: ( FromJSONKey Tool
|
getDownloads :: ( FromJSONKey Tool
|
||||||
, FromJSONKey Version
|
, FromJSONKey Version
|
||||||
@@ -91,6 +136,7 @@ getDownloads :: ( FromJSONKey Tool
|
|||||||
, MonadLogger m
|
, MonadLogger m
|
||||||
, MonadThrow m
|
, MonadThrow m
|
||||||
, MonadFail m
|
, MonadFail m
|
||||||
|
, MonadReader Settings m
|
||||||
)
|
)
|
||||||
=> URLSource
|
=> URLSource
|
||||||
-> Excepts '[JSONError , DownloadFailed] m GHCupInfo
|
-> 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.
|
-- Always save the local file with the mod time of the remote file.
|
||||||
smartDl :: forall m1
|
smartDl :: forall m1
|
||||||
. (MonadCatch m1, MonadIO m1, MonadFail m1, MonadLogger m1)
|
. ( MonadCatch m1
|
||||||
|
, MonadIO m1
|
||||||
|
, MonadFail m1
|
||||||
|
, MonadLogger m1
|
||||||
|
, MonadReader Settings m1
|
||||||
|
)
|
||||||
=> URI
|
=> URI
|
||||||
-> Excepts
|
-> Excepts
|
||||||
'[ FileDoesNotExistError
|
'[ FileDoesNotExistError
|
||||||
@@ -148,31 +199,38 @@ getDownloads urlSource = do
|
|||||||
Just modTime -> do
|
Just modTime -> do
|
||||||
fileMod <- liftIO $ getModificationTime json_file
|
fileMod <- liftIO $ getModificationTime json_file
|
||||||
if modTime > fileMod
|
if modTime > fileMod
|
||||||
then do
|
then dlWithMod modTime json_file
|
||||||
bs <- liftE $ downloadBS uri'
|
|
||||||
liftIO $ writeFileWithModTime modTime json_file bs
|
|
||||||
pure bs
|
|
||||||
else liftIO $ readFile json_file
|
else liftIO $ readFile json_file
|
||||||
Nothing -> do
|
Nothing -> do
|
||||||
lift $ $(logDebug) [i|Unable to get/parse Last-Modified header|]
|
lift $ $(logDebug) [i|Unable to get/parse Last-Modified header|]
|
||||||
liftIO $ deleteFile json_file
|
dlWithoutMod json_file
|
||||||
liftE $ downloadBS uri'
|
|
||||||
else -- access in less than 5 minutes, re-use file
|
else -- access in less than 5 minutes, re-use file
|
||||||
liftIO $ readFile json_file
|
liftIO $ readFile json_file
|
||||||
else do
|
else do
|
||||||
liftIO $ createDirIfMissing newDirPerms cacheDir
|
liftIO $ createDirIfMissing newDirPerms cacheDir
|
||||||
getModTime >>= \case
|
getModTime >>= \case
|
||||||
Just modTime -> do
|
Just modTime -> dlWithMod modTime json_file
|
||||||
bs <- liftE $ downloadBS uri'
|
|
||||||
liftIO $ writeFileWithModTime modTime json_file bs
|
|
||||||
pure bs
|
|
||||||
Nothing -> do
|
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|]
|
lift $ $(logDebug) [i|Unable to get/parse Last-Modified header|]
|
||||||
liftE $ downloadBS uri'
|
dlWithoutMod json_file
|
||||||
|
|
||||||
where
|
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
|
getModTime = do
|
||||||
#if defined(CURL)
|
#if !defined(INTERNAL_DOWNLOADER)
|
||||||
pure Nothing
|
pure Nothing
|
||||||
#else
|
#else
|
||||||
headers <-
|
headers <-
|
||||||
@@ -271,12 +329,19 @@ download dli dest mfn
|
|||||||
(liftIO $ hideError doesNotExistErrorType $ deleteFile destFile)
|
(liftIO $ hideError doesNotExistErrorType $ deleteFile destFile)
|
||||||
>> (throwE . DownloadFailed $ e)
|
>> (throwE . DownloadFailed $ e)
|
||||||
) $ do
|
) $ do
|
||||||
#if defined(CURL)
|
lift getDownloader >>= \case
|
||||||
liftE $ lEM @_ @'[ProcessError] $ liftIO $ exec "curl" True
|
Curl -> do
|
||||||
["-fL", "-o", toFilePath destFile , serializeURIRef' $ view dlUri dli] Nothing Nothing
|
o' <- liftIO getCurlOpts
|
||||||
#else
|
liftE $ lEM @_ @'[ProcessError] $ liftIO $ exec "curl" True
|
||||||
(https, host, fullPath, port) <- liftE $ uriToQuadruple (view dlUri dli)
|
(o' ++ ["-fL", "-o", toFilePath destFile, serializeURIRef' $ view dlUri dli]) Nothing Nothing
|
||||||
liftE $ downloadToFile https host fullPath port destFile
|
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
|
#endif
|
||||||
|
|
||||||
liftE $ checkDigest dli destFile
|
liftE $ checkDigest dli destFile
|
||||||
@@ -329,7 +394,7 @@ downloadCached dli mfn = do
|
|||||||
|
|
||||||
|
|
||||||
-- | This is used for downloading the JSON.
|
-- | This is used for downloading the JSON.
|
||||||
downloadBS :: (MonadCatch m, MonadIO m)
|
downloadBS :: (MonadReader Settings m, MonadCatch m, MonadIO m, MonadLogger m)
|
||||||
=> URI
|
=> URI
|
||||||
-> Excepts
|
-> Excepts
|
||||||
'[ FileDoesNotExistError
|
'[ FileDoesNotExistError
|
||||||
@@ -356,18 +421,33 @@ downloadBS uri'
|
|||||||
where
|
where
|
||||||
scheme = view (uriSchemeL' % schemeBSL') uri'
|
scheme = view (uriSchemeL' % schemeBSL') uri'
|
||||||
path = view pathL' uri'
|
path = view pathL' uri'
|
||||||
#if defined(CURL)
|
#if defined(INTERNAL_DOWNLOADER)
|
||||||
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
|
|
||||||
dl https = do
|
dl https = do
|
||||||
(_, host', fullPath', port') <- liftE $ uriToQuadruple uri'
|
#else
|
||||||
liftE $ downloadBS' https host' fullPath' port'
|
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
|
#endif
|
||||||
|
|
||||||
|
|
||||||
@@ -385,3 +465,19 @@ checkDigest dli file = do
|
|||||||
let eDigest = view dlHash dli
|
let eDigest = view dlHash dli
|
||||||
when ((cDigest /= eDigest) && verify) $ throwE (DigestError cDigest eDigest)
|
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 DeriveGeneric #-}
|
||||||
{-# LANGUAGE OverloadedStrings #-}
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
|
|
||||||
@@ -141,9 +142,10 @@ data URLSource = GHCupURL
|
|||||||
|
|
||||||
|
|
||||||
data Settings = Settings
|
data Settings = Settings
|
||||||
{ cache :: Bool
|
{ cache :: Bool
|
||||||
, noVerify :: Bool
|
, noVerify :: Bool
|
||||||
, keepDirs :: KeepDirs
|
, keepDirs :: KeepDirs
|
||||||
|
, downloader :: Downloader
|
||||||
}
|
}
|
||||||
deriving Show
|
deriving Show
|
||||||
|
|
||||||
@@ -153,6 +155,12 @@ data KeepDirs = Always
|
|||||||
| Never
|
| Never
|
||||||
deriving (Eq, Show, Ord)
|
deriving (Eq, Show, Ord)
|
||||||
|
|
||||||
|
data Downloader = Curl
|
||||||
|
| Wget
|
||||||
|
#if defined(INTERNAL_DOWNLOADER)
|
||||||
|
| Internal
|
||||||
|
#endif
|
||||||
|
deriving (Eq, Show, Ord)
|
||||||
|
|
||||||
data DebugInfo = DebugInfo
|
data DebugInfo = DebugInfo
|
||||||
{ diBaseDir :: Path Abs
|
{ diBaseDir :: Path Abs
|
||||||
|
|||||||
@@ -174,6 +174,7 @@ ghcSet mtarget = do
|
|||||||
ghcBin <- (</> ghc) <$> liftIO ghcupBinDir
|
ghcBin <- (</> ghc) <$> liftIO ghcupBinDir
|
||||||
|
|
||||||
-- link destination is of the form ../ghc/<ver>/bin/ghc
|
-- 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
|
liftIO $ handleIO' NoSuchThing (\_ -> pure $ Nothing) $ do
|
||||||
link <- readSymbolicLink $ toFilePath ghcBin
|
link <- readSymbolicLink $ toFilePath ghcBin
|
||||||
Just <$> ghcLinkVersion link
|
Just <$> ghcLinkVersion link
|
||||||
@@ -193,8 +194,8 @@ ghcSet mtarget = do
|
|||||||
MP.setInput rest
|
MP.setInput rest
|
||||||
pure x
|
pure x
|
||||||
)
|
)
|
||||||
<* MP.chunk "/bin/"
|
<* MP.chunk "/"
|
||||||
<* ghcTargetBinP "ghc"
|
<* MP.takeRest
|
||||||
<* MP.eof
|
<* MP.eof
|
||||||
|
|
||||||
|
|
||||||
@@ -349,6 +350,10 @@ getCache :: MonadReader Settings m => m Bool
|
|||||||
getCache = ask <&> cache
|
getCache = ask <&> cache
|
||||||
|
|
||||||
|
|
||||||
|
getDownloader :: MonadReader Settings m => m Downloader
|
||||||
|
getDownloader = ask <&> downloader
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
-------------
|
-------------
|
||||||
--[ Other ]--
|
--[ Other ]--
|
||||||
|
|||||||
@@ -16,7 +16,7 @@ ghcupURL :: URI
|
|||||||
ghcupURL = [uri|https://www.haskell.org/ghcup/data/ghcup-0.0.2.json|]
|
ghcupURL = [uri|https://www.haskell.org/ghcup/data/ghcup-0.0.2.json|]
|
||||||
|
|
||||||
ghcUpVer :: PVP
|
ghcUpVer :: PVP
|
||||||
ghcUpVer = [pver|0.1.4|]
|
ghcUpVer = [pver|0.1.5|]
|
||||||
|
|
||||||
numericVer :: String
|
numericVer :: String
|
||||||
numericVer = T.unpack . prettyPVP $ ghcUpVer
|
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