Compare commits
2 Commits
v0.1.5
...
v0.1.5-alp
| Author | SHA1 | Date | |
|---|---|---|---|
| e88a39de27 | |||
| bc0cd22433 |
@@ -42,8 +42,7 @@ 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 git wget
|
sudo apt-get install -y libnuma-dev zlib1g-dev libgmp-dev libgmp10 libssl-dev liblzma-dev
|
||||||
|
|
||||||
. "$( cd "$(dirname "$0")" ; pwd -P )/../../ghcup_env"
|
. "$( cd "$(dirname "$0")" ; pwd -P )/../../ghcup_env"
|
||||||
|
|
||||||
|
|||||||
@@ -10,17 +10,15 @@ 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} --ghc-options='-split-sections -optl-static'
|
ecabal build -w ghc-${GHC_VERSION} -fcurl --ghc-options='-split-sections -optl-static'
|
||||||
elif [ "${OS}" = "FREEBSD" ] ; then
|
elif [ "${OS}" = "FREEBSD" ] ; then
|
||||||
ecabal build -w ghc-${GHC_VERSION} --ghc-options='-split-sections'
|
ecabal build -w ghc-${GHC_VERSION} -fcurl --ghc-options='-split-sections'
|
||||||
else
|
else
|
||||||
ecabal build -w ghc-${GHC_VERSION}
|
ecabal build -w ghc-${GHC_VERSION} -fcurl
|
||||||
fi
|
fi
|
||||||
|
|
||||||
mkdir out
|
mkdir out
|
||||||
|
|||||||
@@ -14,16 +14,15 @@ 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}
|
ecabal build -w ghc-${GHC_VERSION} -fcurl
|
||||||
else
|
else
|
||||||
ecabal build -w ghc-${GHC_VERSION} -finternal-downloader
|
ecabal build -w ghc-${GHC_VERSION}
|
||||||
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')" .
|
||||||
@@ -71,11 +70,7 @@ 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
|
||||||
if [ "${OS}" = "LINUX" ] ; then
|
eghcup install 8.4.4
|
||||||
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,21 +1,5 @@
|
|||||||
# 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,22 +43,3 @@ 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,8 +11,6 @@ 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)
|
||||||
@@ -70,25 +68,11 @@ 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.
|
||||||
|
|
||||||
### Shell-completion
|
### Bash-completion
|
||||||
|
|
||||||
Shell completions are in `shell-completions`.
|
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
|
||||||
For bash: install `shell-completions/bash`
|
startup script (`/usr/share/bash-completion/bash_completion` on some distros).
|
||||||
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,11 +4,8 @@
|
|||||||
|
|
||||||
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 and release artifacts to build.
|
3. Commit and git push with tag. Wait for tests to succeed.
|
||||||
|
|
||||||
4. Download release artifacts and upload them `downloads.haskell.org/ghcup`
|
4. Upload the new `ghcup-<ver>.json` to `webhost.haskell.org/ghcup/data/`.
|
||||||
|
|
||||||
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 Curl
|
let settings = Settings True False Never
|
||||||
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,7 +76,6 @@ 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
|
||||||
}
|
}
|
||||||
@@ -182,25 +181,8 @@ opts =
|
|||||||
( long "keep"
|
( long "keep"
|
||||||
<> metavar "<always|errors|never>"
|
<> metavar "<always|errors|never>"
|
||||||
<> help
|
<> help
|
||||||
"Keep build directories? (default: never)"
|
"Keep build directories?"
|
||||||
<> 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
|
||||||
@@ -576,16 +558,6 @@ 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
|
||||||
@@ -650,10 +622,9 @@ 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 { .. }
|
||||||
|
|
||||||
|
|
||||||
@@ -841,9 +812,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, FileDoesNotExistError]
|
. runE @'[JSONError , DownloadFailed]
|
||||||
$ liftE
|
$ liftE
|
||||||
$ getDownloadsF (maybe GHCupURL OwnSource optUrlSource)
|
$ getDownloads (maybe GHCupURL OwnSource optUrlSource)
|
||||||
)
|
)
|
||||||
>>= \case
|
>>= \case
|
||||||
VRight r -> pure r
|
VRight r -> pure r
|
||||||
|
|||||||
@@ -58,33 +58,6 @@
|
|||||||
"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.5
|
version: 0.1.4
|
||||||
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 internal-downloader
|
flag Curl
|
||||||
description: Compile the internal downloader, which links against OpenSSL
|
description: Use curl instead of http-io-streams for download
|
||||||
default: False
|
default: False
|
||||||
manual: True
|
manual: True
|
||||||
|
|
||||||
@@ -302,14 +302,15 @@ library
|
|||||||
-- other-extensions:
|
-- other-extensions:
|
||||||
hs-source-dirs: lib
|
hs-source-dirs: lib
|
||||||
|
|
||||||
if flag(internal-downloader)
|
if !flag(curl)
|
||||||
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
|
||||||
cpp-options: -DINTERNAL_DOWNLOADER
|
else
|
||||||
|
cpp-options: -DCURL
|
||||||
|
|
||||||
executable ghcup
|
executable ghcup
|
||||||
import:
|
import:
|
||||||
@@ -344,10 +345,6 @@ 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,7 +5,6 @@ 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
|
||||||
|
|
||||||
@@ -62,35 +61,6 @@ 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(INTERNAL_DOWNLOADER)
|
#if !defined(CURL)
|
||||||
import GHCup.Download.IOStreams
|
import GHCup.Download.IOStreams
|
||||||
import GHCup.Download.Utils
|
import GHCup.Download.Utils
|
||||||
#endif
|
#endif
|
||||||
@@ -35,19 +35,18 @@ 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(INTERNAL_DOWNLOADER)
|
#if !defined(CURL)
|
||||||
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
|
||||||
@@ -58,14 +57,12 @@ 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(INTERNAL_DOWNLOADER)
|
#if !defined(CURL)
|
||||||
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
|
||||||
@@ -85,48 +82,6 @@ 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
|
||||||
@@ -136,7 +91,6 @@ 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
|
||||||
@@ -162,12 +116,7 @@ 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
|
. (MonadCatch m1, MonadIO m1, MonadFail m1, MonadLogger m1)
|
||||||
, MonadIO m1
|
|
||||||
, MonadFail m1
|
|
||||||
, MonadLogger m1
|
|
||||||
, MonadReader Settings m1
|
|
||||||
)
|
|
||||||
=> URI
|
=> URI
|
||||||
-> Excepts
|
-> Excepts
|
||||||
'[ FileDoesNotExistError
|
'[ FileDoesNotExistError
|
||||||
@@ -199,38 +148,31 @@ 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 dlWithMod modTime json_file
|
then do
|
||||||
|
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|]
|
||||||
dlWithoutMod json_file
|
liftIO $ deleteFile 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 -> dlWithMod modTime json_file
|
Just modTime -> do
|
||||||
|
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|]
|
||||||
dlWithoutMod json_file
|
liftE $ downloadBS uri'
|
||||||
|
|
||||||
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(INTERNAL_DOWNLOADER)
|
#if defined(CURL)
|
||||||
pure Nothing
|
pure Nothing
|
||||||
#else
|
#else
|
||||||
headers <-
|
headers <-
|
||||||
@@ -329,19 +271,12 @@ download dli dest mfn
|
|||||||
(liftIO $ hideError doesNotExistErrorType $ deleteFile destFile)
|
(liftIO $ hideError doesNotExistErrorType $ deleteFile destFile)
|
||||||
>> (throwE . DownloadFailed $ e)
|
>> (throwE . DownloadFailed $ e)
|
||||||
) $ do
|
) $ do
|
||||||
lift getDownloader >>= \case
|
#if defined(CURL)
|
||||||
Curl -> do
|
liftE $ lEM @_ @'[ProcessError] $ liftIO $ exec "curl" True
|
||||||
o' <- liftIO getCurlOpts
|
["-fL", "-o", toFilePath destFile , serializeURIRef' $ view dlUri dli] Nothing Nothing
|
||||||
liftE $ lEM @_ @'[ProcessError] $ liftIO $ exec "curl" True
|
#else
|
||||||
(o' ++ ["-fL", "-o", toFilePath destFile, serializeURIRef' $ view dlUri dli]) Nothing Nothing
|
(https, host, fullPath, port) <- liftE $ uriToQuadruple (view dlUri dli)
|
||||||
Wget -> do
|
liftE $ downloadToFile https host fullPath port destFile
|
||||||
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
|
||||||
@@ -394,7 +329,7 @@ downloadCached dli mfn = do
|
|||||||
|
|
||||||
|
|
||||||
-- | This is used for downloading the JSON.
|
-- | This is used for downloading the JSON.
|
||||||
downloadBS :: (MonadReader Settings m, MonadCatch m, MonadIO m, MonadLogger m)
|
downloadBS :: (MonadCatch m, MonadIO m)
|
||||||
=> URI
|
=> URI
|
||||||
-> Excepts
|
-> Excepts
|
||||||
'[ FileDoesNotExistError
|
'[ FileDoesNotExistError
|
||||||
@@ -421,33 +356,18 @@ downloadBS uri'
|
|||||||
where
|
where
|
||||||
scheme = view (uriSchemeL' % schemeBSL') uri'
|
scheme = view (uriSchemeL' % schemeBSL') uri'
|
||||||
path = view pathL' uri'
|
path = view pathL' uri'
|
||||||
#if defined(INTERNAL_DOWNLOADER)
|
#if defined(CURL)
|
||||||
dl https = do
|
|
||||||
#else
|
|
||||||
dl _ = do
|
dl _ = do
|
||||||
#endif
|
let exe = [rel|curl|]
|
||||||
lift $ $(logDebug) [i|downloading: #{serializeURIRef' uri'}|]
|
args = ["-sSfL", serializeURIRef' uri']
|
||||||
lift getDownloader >>= \case
|
liftIO (executeOut exe args Nothing) >>= \case
|
||||||
Curl -> do
|
CapturedProcess ExitSuccess stdout _ -> do
|
||||||
o' <- liftIO getCurlOpts
|
pure $ L.fromStrict stdout
|
||||||
let exe = [rel|curl|]
|
CapturedProcess (ExitFailure i') _ _ -> throwE $ NonZeroExit i' (toFilePath exe) args
|
||||||
args = o' ++ ["-sSfL", serializeURIRef' uri']
|
#else
|
||||||
liftIO (executeOut exe args Nothing) >>= \case
|
dl https = do
|
||||||
CapturedProcess ExitSuccess stdout _ -> do
|
(_, host', fullPath', port') <- liftE $ uriToQuadruple uri'
|
||||||
pure $ L.fromStrict stdout
|
liftE $ downloadBS' https host' fullPath' port'
|
||||||
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
|
||||||
|
|
||||||
|
|
||||||
@@ -465,19 +385,3 @@ 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,4 +1,3 @@
|
|||||||
{-# LANGUAGE CPP #-}
|
|
||||||
{-# LANGUAGE DeriveGeneric #-}
|
{-# LANGUAGE DeriveGeneric #-}
|
||||||
{-# LANGUAGE OverloadedStrings #-}
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
|
|
||||||
@@ -142,10 +141,9 @@ 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
|
||||||
|
|
||||||
@@ -155,12 +153,6 @@ 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,7 +174,6 @@ 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
|
||||||
@@ -194,8 +193,8 @@ ghcSet mtarget = do
|
|||||||
MP.setInput rest
|
MP.setInput rest
|
||||||
pure x
|
pure x
|
||||||
)
|
)
|
||||||
<* MP.chunk "/"
|
<* MP.chunk "/bin/"
|
||||||
<* MP.takeRest
|
<* ghcTargetBinP "ghc"
|
||||||
<* MP.eof
|
<* MP.eof
|
||||||
|
|
||||||
|
|
||||||
@@ -350,10 +349,6 @@ 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.5|]
|
ghcUpVer = [pver|0.1.4|]
|
||||||
|
|
||||||
numericVer :: String
|
numericVer :: String
|
||||||
numericVer = T.unpack . prettyPVP $ ghcUpVer
|
numericVer = T.unpack . prettyPVP $ ghcUpVer
|
||||||
|
|||||||
@@ -1,19 +0,0 @@
|
|||||||
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)'
|
|
||||||
@@ -1,32 +0,0 @@
|
|||||||
#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