Compare commits

..

2 Commits

Author SHA1 Message Date
e88a39de27 Fix release builds 2020-04-27 16:23:44 +02:00
bc0cd22433 First cross try 2020-04-27 07:49:08 +02:00
20 changed files with 69 additions and 380 deletions

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

@@ -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": ""
}
} }
} }
} }

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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