Compare commits

...

29 Commits

Author SHA1 Message Date
b0f90c096f Fix chmod on executables, wrt #97 2020-12-20 01:27:27 +08:00
e8361c564a Merge remote-tracking branch 'origin/merge-requests/51' 2020-12-19 03:30:40 +08:00
amesgen
54db9c9a92 update HLS to 0.7.1 2020-12-18 15:32:50 +01:00
amesgen
73db341dc8 update HLS to 0.7.0 2020-12-16 00:58:26 +01:00
5fd30b412b Merge remote-tracking branch 'origin/merge-requests/49' 2020-11-28 12:46:16 +01:00
Anton-Latukha
bbe2e87640 CHANGELOG.md: add note about ghcup directory fix` 2020-11-28 12:34:58 +02:00
Anton-Latukha
67f59f6895 bootstrap-haskell: fx XDG GHCUP_DIR value 2020-11-28 01:41:43 +02:00
Anton-Latukha
3e2df2e111 bootstrap-haskell: create GHCUP_DIR 2020-11-28 01:27:35 +02:00
824d2149c6 Merge remote-tracking branch 'origin/merge-requests/48' 2020-11-27 20:26:33 +01:00
Anton-Latukha
c86dbe043b bootstrap-haskell: mention the license
Since script is served separately from the main source code (can be opened over
https://get-ghcup.haskell.org) - mention the script license to the reciever.
2020-11-27 17:06:39 +02:00
Anton-Latukha
8043ac7f51 bootstrap-haskell: provide instructions for the main settings
Provide some basic instructive information to someone who views the script.
2020-11-27 17:04:00 +02:00
b20371c3ac Add default values to all XDG_ variables documentation 2020-11-21 16:31:50 +01:00
0589a7cbcc Document XDG_CONFIG_HOME wrt #85 2020-11-21 16:29:26 +01:00
cf48961063 Bump ghcup to 0.1.12 2020-11-21 14:23:37 +01:00
6046582b9c Improve version ranges 2020-11-21 14:05:34 +01:00
82aa6c70ea Allow to encode version ranges for distro versions
Fixes #84
2020-11-21 01:12:15 +01:00
e829bd8235 Fix brick not updating downloads correctly 2020-11-21 00:32:58 +01:00
66f989e691 Fix FromJSONKey instances
This led to silent Nothing when the parser failed.
2020-11-20 23:18:25 +01:00
eebb91fbb0 Use extra-doc-files for CHANGELOG.md 2020-11-20 23:16:13 +01:00
1d3e88bdfe Fix disappearing HLS symlinks wrt #91
When installing a new GHC version, the corresponding
HLS symlink of that version may be accidentially removed.

Ooops.
2020-11-20 23:05:37 +01:00
fbb03dee7e Merge remote-tracking branch 'origin/merge-requests/44' into master 2020-11-12 10:49:26 +01:00
amesgen
88e5afb70f update HLS to 0.6.0 2020-11-11 23:19:05 +01:00
67eabfd3af Update CHANGELOG 2020-10-30 22:27:41 +01:00
cd1dd8c29e Merge branch 'PR/82' into master 2020-10-30 22:26:33 +01:00
08ddb591b7 Add toolchain sanity checks wrt #82 2020-10-30 21:07:49 +01:00
3e841b3c68 Merge branch 'settings' into master 2020-10-26 18:25:20 +01:00
53f5a08924 Allow configuring URLSource as well 2020-10-25 14:47:26 +01:00
d368863c3d Improve help output 2020-10-25 11:00:00 +01:00
c76cce5830 Add a --set option to install/compile, fixes #81 2020-10-25 10:54:04 +01:00
22 changed files with 9723 additions and 15761 deletions

View File

@@ -60,7 +60,7 @@ variables:
script:
- ./.gitlab/script/ghcup_version.sh
variables:
JSON_VERSION: "0.0.3"
JSON_VERSION: "0.0.4"
artifacts:
expire_in: 2 week
paths:

View File

@@ -1,13 +1,23 @@
# Revision history for ghcup
## 0.1.12 -- ????-??-??
## WIP
* Fix to `ghcup` directory creation and placement for the XDG install mode.
## 0.1.12 -- 2020-11-21
* Fix disappearing HLS symlinks wrt #91
* improve TUI:
- separators between tools sections
- reverse list order so latest is on top
- expand the blues selected bar
- show new latest versions in bright white
* allow configuration file and settings TUI hotkeys wrt #41
* allow configuration file and setting TUI hotkeys wrt #41
- see https://gitlab.haskell.org/haskell/ghcup-hs#configuration for a more in-depth explanation
* add a `--set` switch to `ghcup install ghc` to automatically set as default after install
* emit warnings when CC/LD is set wrt #82
* add support for version ranges in distro specifiers wrt #84
- e.g. `"(>= 19 && <= 20) || ==0.2.2"` is a valid version key for distro
## 0.1.11 -- 2020-09-23

View File

@@ -83,42 +83,8 @@ handles your haskell packages and can demand that [a specific version](https://c
### Configuration
A configuration file can be put in `~/.ghcup/config.yaml`. Here is the complete default
configuration:
```yaml
# Cache downloads in ~/.ghcup/cache
cache: False
# Skip tarball checksum verification
no-verify: False
# enable verbosity
verbose: False
# When to keep build directories
keep-dirs: Errors # Always | Never | Errors
# Which downloader to use
downloader: Curl # Curl | Wget | Internal
# TUI key bindings,
# see https://hackage.haskell.org/package/vty-5.31/docs/Graphics-Vty-Input-Events.html#t:Key
# for possible values.
key-bindings:
up:
KUp: []
down:
KDown: []
quit:
KChar: 'q'
install:
KChar: 'i'
uninstall:
KChar: 'u'
set:
KChar: 's'
changelog:
KChar: 'c'
show-all:
KChar: 'a'
```
A configuration file can be put in `~/.ghcup/config.yaml`. The default config file
explaining all possible configurations can be found in this repo: [config.yaml](./config.yaml).
Partial configuration is fine. Command line options always overwrite the config file settings.
@@ -153,9 +119,10 @@ To enable XDG style directories, set the environment variable `GHCUP_USE_XDG_DIR
Then you can control the locations via XDG environment variables as such:
* `XDG_DATA_HOME`: GHCs will be unpacked in `ghcup/ghc` subdir
* `XDG_CACHE_HOME`: logs and download files will be stored in `ghcup` subdir
* `XDG_DATA_HOME`: GHCs will be unpacked in `ghcup/ghc` subdir (default: `~/.local/share`)
* `XDG_CACHE_HOME`: logs and download files will be stored in `ghcup` subdir (default: `~/.cache`)
* `XDG_BIN_HOME`: binaries end up here (default: `~/.local/bin`)
* `XDG_CONFIG_HOME`: the config file is stored in `ghcup` subdir as `config.yaml` (default: `~/.config`)
### Installing custom bindists

View File

@@ -193,7 +193,7 @@ validateTarballs dls = do
where
downloadAll dli = do
dirs <- liftIO getDirs
let settings = AppState (Settings True False Never Curl False) dirs defaultKeyBindings
let settings = AppState (Settings True False Never Curl False GHCupURL) dirs defaultKeyBindings
let runLogger = myLoggerT LoggerConfig { lcPrintDebug = True
, colorOutter = B.hPut stderr
, rawOutter = (\_ -> pure ())

View File

@@ -48,6 +48,8 @@ import System.Exit
import System.IO.Unsafe
import URI.ByteString
import qualified GHCup.Types as GT
import qualified Data.Text as T
import qualified Graphics.Vty as Vty
import qualified Data.Vector as V
@@ -480,11 +482,6 @@ changelog' BrickState { appData = BrickData {..} } (_, ListResult {..}) = do
Left e -> pure $ Left [i|#{e}|]
uri' :: IORef (Maybe URI)
{-# NOINLINE uri' #-}
uri' = unsafePerformIO (newIORef Nothing)
settings' :: IORef AppState
{-# NOINLINE settings' #-}
settings' = unsafePerformIO $ do
@@ -494,6 +491,7 @@ settings' = unsafePerformIO $ do
, keepDirs = Never
, downloader = Curl
, verbose = False
, urlSource = GHCupURL
, ..
})
dirs
@@ -512,13 +510,11 @@ logger' = unsafePerformIO
brickMain :: AppState
-> Maybe URI
-> LoggerConfig
-> GHCupDownloads
-> PlatformRequest
-> IO ()
brickMain s muri l av pfreq' = do
writeIORef uri' muri
brickMain s l av pfreq' = do
writeIORef settings' s
-- logger interpreter
writeIORef logger' l
@@ -547,7 +543,6 @@ defaultAppSettings = BrickSettings { showAll = False }
getDownloads' :: IO (Either String GHCupDownloads)
getDownloads' = do
muri <- readIORef uri'
settings <- readIORef settings'
l <- readIORef logger'
let runLogger = myLoggerT l
@@ -558,7 +553,7 @@ getDownloads' = do
. runE @'[JSONError , DownloadFailed , FileDoesNotExistError]
$ fmap _ghcupDownloads
$ liftE
$ getDownloadsF (maybe GHCupURL OwnSource muri)
$ getDownloadsF (urlSource . GT.settings $ settings)
case r of
VRight a -> pure $ Right a

View File

@@ -122,6 +122,7 @@ data InstallOptions = InstallOptions
{ instVer :: Maybe ToolVersion
, instPlatform :: Maybe PlatformRequest
, instBindist :: Maybe URI
, instSet :: Bool
}
data SetCommand = SetGHC SetOptions
@@ -158,6 +159,7 @@ data GHCCompileOptions = GHCCompileOptions
, patchDir :: Maybe (Path Abs)
, crossTarget :: Maybe Text
, addConfArgs :: [Text]
, setCompile :: Bool
}
data CabalCompileOptions = CabalCompileOptions
@@ -372,20 +374,20 @@ com =
installToolFooter = [s|Discussion:
Installs GHC or cabal. When no command is given, installs GHC
with the specified version/tag.
It is recommended to always specify a subcommand ('ghc' or 'cabal').|]
It is recommended to always specify a subcommand (ghc/cabal/hls).|]
setFooter :: String
setFooter = [s|Discussion:
Sets the currently active GHC or cabal version. When no command is given,
defaults to setting GHC with the specified version/tag (if no tag
is given, sets GHC to 'recommended' version).
It is recommended to always specify a subcommand ('ghc' or 'cabal').|]
It is recommended to always specify a subcommand (ghc/cabal/hls).|]
rmFooter :: String
rmFooter = [s|Discussion:
Remove the given GHC or cabal version. When no command is given,
defaults to removing GHC with the specified version.
It is recommended to always specify a subcommand ('ghc' or 'cabal').|]
It is recommended to always specify a subcommand (ghc/cabal/hls).|]
changeLogFooter :: String
changeLogFooter = [s|Discussion:
@@ -470,7 +472,7 @@ Examples:
installOpts :: Parser InstallOptions
installOpts =
(\p (u, v) -> InstallOptions v p u)
(\p (u, v) b -> InstallOptions v p u b)
<$> (optional
(option
(eitherReader platformParser)
@@ -495,6 +497,12 @@ installOpts =
)
<|> ((,) <$> pure Nothing <*> optional toolVersionArgument)
)
<*> flag
False
True
(long "set" <> help
"Set as active version after install"
)
setParser :: Parser (Either SetCommand SetOptions)
@@ -664,7 +672,7 @@ Examples:
ghcCompileOpts :: Parser GHCCompileOptions
ghcCompileOpts =
(\CabalCompileOptions {..} crossTarget addConfArgs -> GHCCompileOptions { .. }
(\CabalCompileOptions {..} crossTarget addConfArgs setCompile -> GHCCompileOptions { .. }
)
<$> cabalCompileOpts
<*> (optional
@@ -676,6 +684,12 @@ ghcCompileOpts =
)
)
<*> many (argument str (metavar "CONFIGURE_ARGS" <> help "Additional arguments to configure, prefix with '-- ' (longopts)"))
<*> flag
False
True
(long "set" <> help
"Set as active version after install"
)
cabalCompileOpts :: Parser CabalCompileOptions
cabalCompileOpts =
@@ -738,9 +752,9 @@ cabalCompileOpts =
toolVersionParser :: Parser ToolVersion
toolVersionParser = verP <|> toolP
toolVersionParser = verP' <|> toolP
where
verP = ToolVersion <$> versionParser
verP' = ToolVersion <$> versionParser
toolP =
ToolTag
<$> (option
@@ -868,17 +882,6 @@ platformParser s' = case MP.parse (platformP <* MP.eof) "" (T.pack s') of
, MP.chunk "exherbo" $> Exherbo
, MP.chunk "unknown" $> UnknownLinux
]
verP :: MP.Parsec Void Text Text -> MP.Parsec Void Text Versioning
verP suffix = do
ver <- parseUntil suffix
if T.null ver
then fail "empty version"
else do
rest <- MP.getInput
MP.setInput ver
v <- versioning'
MP.setInput rest
pure v
bindistParser :: String -> Either String URI
@@ -899,12 +902,13 @@ toSettings options = do
where
mergeConf :: Options -> Dirs -> UserSettings -> AppState
mergeConf (Options {..}) dirs (UserSettings {..}) =
let cache = fromMaybe (fromMaybe False uCache) optCache
noVerify = fromMaybe (fromMaybe False uNoVerify) optNoVerify
verbose = fromMaybe (fromMaybe False uVerbose) optVerbose
keepDirs = fromMaybe (fromMaybe Errors uKeepDirs) optKeepDirs
downloader = fromMaybe (fromMaybe defaultDownloader uDownloader) optsDownloader
let cache = fromMaybe (fromMaybe False uCache) optCache
noVerify = fromMaybe (fromMaybe False uNoVerify) optNoVerify
verbose = fromMaybe (fromMaybe False uVerbose) optVerbose
keepDirs = fromMaybe (fromMaybe Errors uKeepDirs) optKeepDirs
downloader = fromMaybe (fromMaybe defaultDownloader uDownloader) optsDownloader
keyBindings = maybe defaultKeyBindings mergeKeys uKeyBindings
urlSource = maybe (fromMaybe GHCupURL uUrlSource) OwnSource optUrlSource
in AppState (Settings {..}) dirs keyBindings
#if defined(INTERNAL_DOWNLOADER)
defaultDownloader = Internal
@@ -990,6 +994,7 @@ main = do
ENV variables:
* TMPDIR: where ghcup does the work (unpacking, building, ...)
* GHCUP_INSTALL_BASE_PREFIX: the base of ghcup (default: $HOME)
* GHCUP_USE_XDG_DIRS: set to anything to use XDG style directories
Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
@@ -1134,7 +1139,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
. flip runReaderT appstate
. runE @'[JSONError , DownloadFailed, FileDoesNotExistError]
$ liftE
$ getDownloadsF (maybe GHCupURL OwnSource optUrlSource)
$ getDownloadsF (urlSource settings)
)
>>= \case
VRight r -> pure r
@@ -1158,12 +1163,14 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
Nothing -> runInstTool $ do
v <- liftE $ fromVersion dls instVer GHC
liftE $ installGHCBin dls (_tvVersion v) (fromMaybe pfreq instPlatform)
when instSet $ void $ liftE $ setGHC v SetGHCOnly
Just uri -> runInstTool' appstate{ settings = settings {noVerify = True}} $ do
v <- liftE $ fromVersion dls instVer GHC
liftE $ installGHCBindist
(DownloadInfo uri (Just $ RegexDir "ghc-.*") "")
(_tvVersion v)
(fromMaybe pfreq instPlatform)
when instSet $ void $ liftE $ setGHC v SetGHCOnly
)
>>= \case
VRight _ -> do
@@ -1331,7 +1338,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
res <- case optCommand of
#if defined(BRICK)
Interactive -> liftIO $ brickMain appstate optUrlSource loggerConfig dls pfreq >> pure ExitSuccess
Interactive -> liftIO $ brickMain appstate loggerConfig dls pfreq >> pure ExitSuccess
#endif
Install (Right iopts) -> do
runLogger ($(logWarn) [i|This is an old-style command for installing GHC. Use 'ghcup install ghc' instead.|])
@@ -1376,14 +1383,17 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
pure $ ExitFailure 8
Compile (CompileGHC GHCCompileOptions {..}) ->
(runCompileGHC $ liftE $ compileGHC dls
(GHCTargetVersion crossTarget targetVer)
bootstrapGhc
jobs
buildConfig
patchDir
addConfArgs
pfreq
(runCompileGHC $ do
liftE $ compileGHC dls
(GHCTargetVersion crossTarget targetVer)
bootstrapGhc
jobs
buildConfig
patchDir
addConfArgs
pfreq
when setCompile $ void $ liftE
$ setGHC (GHCTargetVersion crossTarget targetVer) SetGHCOnly
)
>>= \case
VRight _ -> do

View File

@@ -1,5 +1,16 @@
#!/bin/sh
# Main settings:
# * BOOTSTRAP_HASKELL_NONINTERACTIVE - any nonzero value for noninteractive installation
# * BOOTSTRAP_HASKELL_NO_UPGRADE - any nonzero value to not trigger the upgrade
# * GHCUP_USE_XDG_DIRS - any nonzero value to respect The XDG Base Directory Specification
# * BOOTSTRAP_HASKELL_VERBOSE - any nonzero value for more verbose installation
# * BOOTSTRAP_HASKELL_GHC_VERSION
# * BOOTSTRAP_HASKELL_CABAL_VERSION
# License: LGPL-3.0
# safety subshell to avoid executing anything in case this script is not downloaded properly
(
@@ -8,7 +19,7 @@
export GHCUP_USE_XDG_DIRS
if [ -n "${GHCUP_USE_XDG_DIRS}" ] ; then
GHCUP_DIR=${XDG_DATA_HOME:=$HOME/.local}/ghcup
GHCUP_DIR=${XDG_DATA_HOME:=$HOME/.local/share}/ghcup
GHCUP_BIN=${XDG_BIN_HOME:=$HOME/.local/bin}
else
GHCUP_DIR=${GHCUP_INSTALL_BASE_PREFIX}/.ghcup
@@ -23,8 +34,7 @@ die() {
exit 2
}
edo()
{
edo() {
"$@" || die "\"$*\" failed!"
}
@@ -59,7 +69,7 @@ _done() {
download_ghcup() {
_plat="$(uname -s)"
_arch=$(uname -m)
_ghver="0.1.11"
_ghver="0.1.12"
_base_url="https://downloads.haskell.org/~ghcup"
case "${_plat}" in
@@ -114,6 +124,7 @@ download_ghcup() {
edo chmod +x "${GHCUP_BIN}"/ghcup
edo mkdir -p "${GHCUP_DIR}"
cat <<-EOF > "${GHCUP_DIR}"/env || die "Failed to create env file"
export PATH="\$HOME/.cabal/bin:${GHCUP_BIN}:\$PATH"
EOF

61
config.yaml Normal file
View File

@@ -0,0 +1,61 @@
# Cache downloads in ~/.ghcup/cache
cache: False
# Skip tarball checksum verification
no-verify: False
# enable verbosity
verbose: False
# When to keep build directories
keep-dirs: Errors # Always | Never | Errors
# Which downloader to use
downloader: Curl # Curl | Wget | Internal
# TUI key bindings,
# see https://hackage.haskell.org/package/vty-5.31/docs/Graphics-Vty-Input-Events.html#t:Key
# for possible values.
key-bindings:
up:
KUp: []
down:
KDown: []
quit:
KChar: 'q'
install:
KChar: 'i'
uninstall:
KChar: 'u'
set:
KChar: 's'
changelog:
KChar: 'c'
show-all:
KChar: 'a'
# Where to get GHC/cabal/hls download info/versions from. For more detailed explanation
# check the 'URLSource' type in the code.
url-source:
## Use the internal download uri, this is the default
GHCupURL: []
## Example 1: Read download info from this location instead
## Accepts file/http/https scheme
# OwnSource: "file:///home/jule/git/ghcup-hs/ghcup-0.0.3.yaml"
## Example 2: Add custom tarballs to the default downloads, overwriting duplicate versions
# AddSource:
# Left:
# toolRequirements: {} # this is ignored
# ghcupDownloads:
# GHC:
# 9.10.2:
# viTags: []
# viArch:
# A_64:
# Linux_UnknownLinux:
# unknown_versioning:
# dlUri: https://downloads.haskell.org/~ghc/7.10.3/ghc-7.10.3-x86_64-deb8-linux.tar.bz2
# dlSubdir: ghc-7.10.3
# dlHash: 01cfbad8dff1e8b34a5fdca8caeaf843b56e36af919e29cd68870d2588563db5
## Example 3: Add a custom download file to the default downloads, overwriting duplicate versions
# AddSource:
# Right: "file:///home/jule/git/ghcup-hs/ghcup-custom.yaml"

View File

@@ -95,7 +95,6 @@ ghcupDownloads:
7.10.3:
viTags:
- base-4.8.2.0
- old
viChangeLog: https://downloads.haskell.org/~ghc/7.10.3/docs/html/users_guide/release-7-10-1.html
viSourceDL:
dlUri: https://downloads.haskell.org/~ghc/7.10.3/ghc-7.10.3-src.tar.xz
@@ -158,7 +157,6 @@ ghcupDownloads:
8.0.2:
viTags:
- base-4.9.1.0
- old
viChangeLog: https://downloads.haskell.org/~ghc/8.0.2/docs/html/users_guide/8.0.1-notes.html
viSourceDL:
dlUri: https://downloads.haskell.org/~ghc/8.0.2/ghc-8.0.2-src.tar.xz
@@ -216,7 +214,6 @@ ghcupDownloads:
8.2.2:
viTags:
- base-4.10.1.0
- old
viChangeLog: https://downloads.haskell.org/~ghc/8.2.2/docs/html/users_guide/8.2.2-notes.html
viSourceDL:
dlUri: https://downloads.haskell.org/~ghc/8.2.2/ghc-8.2.2-src.tar.xz
@@ -283,7 +280,6 @@ ghcupDownloads:
8.4.1:
viTags:
- base-4.11.0.0
- old
viChangeLog: https://downloads.haskell.org/~ghc/8.4.1/docs/html/users_guide/8.4.1-notes.html
viSourceDL:
dlUri: https://downloads.haskell.org/~ghc/8.4.1/ghc-8.4.1-src.tar.xz
@@ -332,7 +328,6 @@ ghcupDownloads:
8.4.2:
viTags:
- base-4.11.1.0
- old
viChangeLog: https://downloads.haskell.org/~ghc/8.4.2/docs/html/users_guide/8.4.2-notes.html
viSourceDL:
dlUri: https://downloads.haskell.org/~ghc/8.4.2/ghc-8.4.2-src.tar.xz
@@ -387,7 +382,6 @@ ghcupDownloads:
8.4.3:
viTags:
- base-4.11.1.0
- old
viChangeLog: https://downloads.haskell.org/~ghc/8.4.3/docs/html/users_guide/8.4.3-notes.html
viSourceDL:
dlUri: https://downloads.haskell.org/~ghc/8.4.3/ghc-8.4.3-src.tar.xz
@@ -510,7 +504,6 @@ ghcupDownloads:
8.6.1:
viTags:
- base-4.12.0.0
- old
viChangeLog: https://downloads.haskell.org/~ghc/8.6.1/docs/html/users_guide/8.6.1-notes.html
viSourceDL:
dlUri: https://downloads.haskell.org/~ghc/8.6.1/ghc-8.6.1-src.tar.xz
@@ -565,7 +558,6 @@ ghcupDownloads:
8.6.2:
viTags:
- base-4.12.0.0
- old
viChangeLog: https://downloads.haskell.org/~ghc/8.6.2/docs/html/users_guide/8.6.2-notes.html
viSourceDL:
dlUri: https://downloads.haskell.org/~ghc/8.6.2/ghc-8.6.2-src.tar.xz
@@ -611,7 +603,6 @@ ghcupDownloads:
8.6.3:
viTags:
- base-4.12.0.0
- old
viChangeLog: https://downloads.haskell.org/~ghc/8.6.3/docs/html/users_guide/8.6.3-notes.html
viSourceDL:
dlUri: https://downloads.haskell.org/~ghc/8.6.3/ghc-8.6.3-src.tar.xz
@@ -675,7 +666,6 @@ ghcupDownloads:
8.6.4:
viTags:
- base-4.12.0.0
- old
viChangeLog: https://downloads.haskell.org/~ghc/8.6.4/docs/html/users_guide/8.6.4-notes.html
viSourceDL:
dlUri: https://downloads.haskell.org/~ghc/8.6.4/ghc-8.6.4-src.tar.xz
@@ -798,7 +788,6 @@ ghcupDownloads:
8.8.1:
viTags:
- base-4.13.0.0
- old
viChangeLog: https://downloads.haskell.org/~ghc/8.8.1/docs/html/users_guide/8.8.1-notes.html
viSourceDL:
dlUri: https://downloads.haskell.org/~ghc/8.8.1/ghc-8.8.1-src.tar.xz
@@ -857,7 +846,6 @@ ghcupDownloads:
8.8.2:
viTags:
- base-4.13.0.0
- old
viChangeLog: https://downloads.haskell.org/~ghc/8.8.2/docs/html/users_guide/8.8.2-notes.html
viSourceDL:
dlUri: https://downloads.haskell.org/~ghc/8.8.2/ghc-8.8.2-src.tar.xz
@@ -916,7 +904,6 @@ ghcupDownloads:
8.8.3:
viTags:
- base-4.13.0.0
- old
viChangeLog: https://downloads.haskell.org/~ghc/8.8.3/docs/html/users_guide/8.8.3-notes.html
viSourceDL:
dlUri: https://downloads.haskell.org/~ghc/8.8.3/ghc-8.8.3-src.tar.xz
@@ -1054,7 +1041,6 @@ ghcupDownloads:
8.10.1:
viTags:
- base-4.14.0.0
- old
viChangeLog: https://downloads.haskell.org/~ghc/8.10.1/docs/html/users_guide/8.10.1-notes.html
viSourceDL:
dlUri: https://downloads.haskell.org/~ghc/8.10.1/ghc-8.10.1-src.tar.xz
@@ -1281,8 +1267,7 @@ ghcupDownloads:
unknown_versioning: *ghc-901a1-32-deb9
Cabal:
2.4.1.0:
viTags:
- old
viTags: []
viChangeLog: https://downloads.haskell.org/~cabal/cabal-install-2.4.1.0/changelog
viArch:
A_64:
@@ -1313,8 +1298,7 @@ ghcupDownloads:
dlSubdir:
dlHash: b2da736cc27609442b10f77fc1a687aba603a7a33045b722dbf1a0066fade198
3.0.0.0:
viTags:
- old
viTags: []
viChangeLog: https://downloads.haskell.org/~cabal/cabal-install-3.0.0.0/changelog
viArch:
A_64:
@@ -1400,7 +1384,7 @@ ghcupDownloads:
dlUri: https://oleg.fi/cabal-install-3.4.0.0-rc4/cabal-install-3.4.0.0-x86_64-freebsd-12.1-release.tar.xz
dlHash: 9705e16d03497b46be4ad477e6c64d10890af853eafa8a9adf6dba89aa9e05f7
GHCup:
0.1.11:
0.1.12:
viTags:
- Recommended
- Latest
@@ -1410,40 +1394,40 @@ ghcupDownloads:
A_64:
Linux_UnknownLinux:
unknown_versioning: &ghcup-64
dlUri: https://downloads.haskell.org/~ghcup/0.1.11/x86_64-linux-ghcup-0.1.11
dlHash: 99d97c9a1dce76892001e5cffd50cc23bf804f2282998c546d1b965aa2179699
dlUri: https://downloads.haskell.org/~ghcup/0.1.12/x86_64-linux-ghcup-0.1.12
dlHash: 83088569ddf2d35df494f440dedd9c8eb2a53276d665f7de731f6554986c2ddb
Darwin:
unknown_versioning:
dlUri: https://downloads.haskell.org/~ghcup/0.1.11/x86_64-apple-darwin-ghcup-0.1.11
dlHash: 4b91dcd9bfdc40534156b8fadea3f317b3c44af1255169895f4911a221f819c6
dlUri: https://downloads.haskell.org/~ghcup/0.1.12/x86_64-apple-darwin-ghcup-0.1.12
dlHash: 1336efb0851e1ed267838f97f6c36cbceb5363ad0ae359f04f1bc43d0c5f2cef
FreeBSD:
unknown_versioning:
dlUri: https://downloads.haskell.org/~ghcup/0.1.11/x86_64-portbld-freebsd-ghcup-0.1.11
dlHash: 6f04ce98d3f3eb9299ce74f8264aa956f0dc38a64a3bd12ee048b7f146e9e1b4
dlUri: https://downloads.haskell.org/~ghcup/0.1.12/x86_64-portbld-freebsd-ghcup-0.1.12
dlHash: a72123e972a53d667574c7d276a81842701a07fce2b434e4d856e561c34772fe
Linux_Alpine:
unknown_versioning: *ghcup-64
A_32:
Linux_UnknownLinux:
unknown_versioning: &ghcup-32
dlUri: https://downloads.haskell.org/~ghcup/0.1.11/i386-linux-ghcup-0.1.11
dlHash: ec339e4c2b8b4d502f66a03c0d3f112cb68cd922dd3c4a6f66323628cf6a76c2
dlUri: https://downloads.haskell.org/~ghcup/0.1.12/i386-linux-ghcup-0.1.12
dlHash: 4bc79a272dfcd16143f08d9f8e33f2fef66dc53f3a0659bdab56ac3cbecf9e84
Linux_Alpine:
unknown_versioning: *ghcup-32
HLS:
0.5.1:
0.7.1:
viTags:
- Recommended
- Latest
viChangeLog: https://github.com/haskell/haskell-language-server/blob/master/ChangeLog.md#051
viChangeLog: https://github.com/haskell/haskell-language-server/blob/master/ChangeLog.md#071
viArch:
A_64:
Linux_UnknownLinux:
unknown_versioning: &hls-64
dlUri: https://github.com/haskell/haskell-language-server/releases/download/0.5.1/haskell-language-server-Linux-0.5.1.tar.gz
dlHash: 8f80a663823033b1d9322de6f86b329e6f7b3f93ba2faea4677989767cb844eb
dlUri: https://github.com/haskell/haskell-language-server/releases/download/0.7.1/haskell-language-server-Linux-0.7.1.tar.gz
dlHash: e74f3bd1f91613a1859a411f369dc34afce9e3e9b7c99ea4f251d81111627f62
Darwin:
unknown_versioning:
dlUri: https://github.com/haskell/haskell-language-server/releases/download/0.5.1/haskell-language-server-macOS-0.5.1.tar.gz
dlHash: a4e557a754df6d2e668714909554a15fea9803f3ff5883268bcf92bf009b45b2
dlUri: https://github.com/haskell/haskell-language-server/releases/download/0.7.1/haskell-language-server-macOS-0.7.1.tar.gz
dlHash: 87ac37cfc74abb4f348a799ee6e76266fe1972dead72b7b11ee1411cc83924ed
Linux_Alpine:
unknown_versioning: *hls-64

1446
ghcup-0.0.4.yaml Normal file

File diff suppressed because it is too large Load Diff

View File

@@ -15,7 +15,7 @@ maintainer: hasufell@posteo.de
copyright: Julian Ospald 2020
category: System
build-type: Simple
extra-source-files: CHANGELOG.md
extra-doc-files: CHANGELOG.md
source-repository head
type: git

File diff suppressed because it is too large Load Diff

View File

@@ -74,7 +74,7 @@ import Prelude hiding ( abs
)
import Safe hiding ( at )
import System.IO.Error
import System.Posix.Env.ByteString ( getEnvironment )
import System.Posix.Env.ByteString ( getEnvironment, getEnv )
import System.Posix.FilePath ( getSearchPath, takeExtension )
import System.Posix.Files.ByteString
import Text.Regex.Posix
@@ -134,10 +134,23 @@ installGHCBindist dlinfo ver pfreq = do
-- prepare paths
ghcdir <- lift $ ghcupGHCDir tver
toolchainSanityChecks
liftE $ installPackedGHC dl (view dlSubdir dlinfo) ghcdir ver pfreq
liftE $ postGHCInstall tver
where
toolchainSanityChecks = do
r <- forM ["CC", "LD"] (liftIO . getEnv)
case catMaybes r of
[] -> pure ()
_ -> do
lift $ $(logWarn) "CC/LD environment variable is set. This will change the compiler/linker"
lift $ $(logWarn) "GHC uses internally and can cause defunct GHC in some cases (e.g. in Anaconda"
lift $ $(logWarn) "environments). If you encounter problems, unset CC and LD and reinstall."
-- | Install a packed GHC distribution. This only deals with unpacking and the GHC
-- build system and nothing else.
installPackedGHC :: ( MonadMask m
@@ -320,7 +333,7 @@ installCabalBindist dlinfo ver (PlatformRequest {..}) = do
(path </> cabalFile)
(destPath)
Overwrite
lift $ chmod_777 destPath
lift $ chmod_755 destPath
-- | Installs cabal into @~\/.ghcup\/bin/cabal-\<ver\>@ and
@@ -436,7 +449,7 @@ installHLSBindist dlinfo ver (PlatformRequest {..}) = do
(path </> f)
(inst </> toF)
Overwrite
lift $ chmod_777 (inst </> toF)
lift $ chmod_755 (inst </> toF)
-- install haskell-language-server-wrapper
let wrapper = [rel|haskell-language-server-wrapper|]
@@ -445,7 +458,7 @@ installHLSBindist dlinfo ver (PlatformRequest {..}) = do
(path </> wrapper)
(inst </> toF)
Overwrite
lift $ chmod_777 (inst </> toF)
lift $ chmod_755 (inst </> toF)
-- | Installs hls binaries @haskell-language-server-\<ghcver\>@
@@ -522,8 +535,8 @@ setGHC ver sghc = do
-- with old ghcup)
case sghc of
SetGHCOnly -> liftE $ rmPlain (_tvTarget ver)
SetGHC_XY -> lift $ rmMajorSymlinks ver
SetGHC_XYZ -> lift $ rmMinorSymlinks ver
SetGHC_XY -> liftE $ rmMajorSymlinks ver
SetGHC_XYZ -> liftE $ rmMinorSymlinks ver
-- for ghc tools (ghc, ghci, haddock, ...)
verfiles <- ghcToolFiles ver
@@ -924,16 +937,17 @@ rmGHCVer ver = do
lift $ $(logInfo) [i|Removing ghc symlinks|]
liftE $ rmPlain (_tvTarget ver)
lift $ $(logInfo) [i|Removing directory recursively: #{toFilePath dir}|]
liftIO $ deleteDirRecursive dir
lift $ $(logInfo) [i|Removing ghc-x.y.z symlinks|]
lift $ rmMinorSymlinks ver
liftE $ rmMinorSymlinks ver
lift $ $(logInfo) [i|Removing/rewiring ghc-x.y symlinks|]
-- first remove
handle (\(_ :: ParseError) -> pure ()) $ lift $ rmMajorSymlinks ver
handle (\(_ :: ParseError) -> pure ()) $ liftE $ rmMajorSymlinks ver
-- then fix them (e.g. with an earlier version)
lift $ $(logInfo) [i|Removing directory recursively: #{toFilePath dir}|]
liftIO $ deleteDirRecursive dir
v' <-
handle
(\(e :: ParseError) -> lift $ $(logWarn) [i|#{e}|] >> pure Nothing)
@@ -1305,7 +1319,7 @@ upgradeGHCup dls mtarget force pfreq = do
handleIO (throwE . CopyError . show) $ liftIO $ copyFile p
fullDest
Overwrite
lift $ chmod_777 fullDest
lift $ chmod_755 fullDest
pure latestVer

View File

@@ -57,6 +57,7 @@ import Data.ByteString ( ByteString )
#if defined(INTERNAL_DOWNLOADER)
import Data.CaseInsensitive ( CI )
#endif
import Data.List ( find )
import Data.Maybe
import Data.String.Interpolate
import Data.Time.Clock
@@ -83,9 +84,9 @@ import qualified Crypto.Hash.SHA256 as SHA256
import qualified Data.ByteString as BS
import qualified Data.ByteString.Base16 as B16
import qualified Data.ByteString.Lazy as L
import qualified Data.Map.Strict as M
#if defined(INTERNAL_DOWNLOADER)
import qualified Data.CaseInsensitive as CI
import qualified Data.Map.Strict as M
import qualified Data.Text as T
#endif
import qualified Data.Text.Encoding as E
@@ -104,8 +105,8 @@ import qualified System.Posix.RawFilePath.Directory
------------------
-- | Like 'getDownloads', but tries to fall back to
-- cached ~/.ghcup/cache/ghcup-<format-ver>.yaml
-- | Downloads the download information! But only if we need to ;P
getDownloadsF :: ( FromJSONKey Tool
, FromJSONKey Version
, FromJSON VersionInfo
@@ -123,15 +124,22 @@ getDownloadsF :: ( FromJSONKey Tool
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
GHCupURL -> liftE getBase
(OwnSource url) -> do
bs <- reThrowAll DownloadFailed $ downloadBS url
lE' JSONDecodeError $ bimap show id $ Y.decodeEither' (L.toStrict bs)
(OwnSpec av) -> pure av
(AddSource (Left ext)) -> do
base <- liftE getBase
pure (mergeGhcupInfo base ext)
(AddSource (Right uri)) -> do
base <- liftE getBase
bsExt <- reThrowAll DownloadFailed $ downloadBS uri
ext <- lE' JSONDecodeError $ bimap show id $ Y.decodeEither' (L.toStrict bsExt)
pure (mergeGhcupInfo base ext)
where
readFromCache :: (MonadIO m, MonadCatch m, MonadLogger m, MonadReader AppState m)
=> Excepts '[JSONError, FileDoesNotExistError] m GHCupInfo
readFromCache = do
AppState {dirs = Dirs {..}} <- lift ask
lift $ $(logWarn)
@@ -145,32 +153,25 @@ getDownloadsF urlSource = do
$ readFile yaml_file
lE' JSONDecodeError $ bimap show id $ Y.decodeEither' (L.toStrict bs)
getBase :: (MonadFail m, MonadIO m, MonadCatch m, MonadLogger m, MonadReader AppState m)
=> Excepts '[JSONError , FileDoesNotExistError] m GHCupInfo
getBase =
handleIO (\_ -> readFromCache)
$ catchE @_ @'[JSONError, FileDoesNotExistError]
(\(DownloadFailed _) -> readFromCache)
$ ((reThrowAll @_ @_ @'[JSONError, DownloadFailed] DownloadFailed $ smartDl ghcupURL)
>>= (liftE . lE' @_ @_ @'[JSONError] JSONDecodeError . bimap show id . Y.decodeEither' . L.toStrict))
-- | Downloads the download information! But only if we need to ;P
getDownloads :: ( FromJSONKey Tool
, FromJSONKey Version
, FromJSON VersionInfo
, MonadIO m
, MonadCatch m
, MonadLogger m
, MonadThrow m
, MonadFail m
, MonadReader AppState m
)
=> URLSource
-> Excepts '[JSONError , DownloadFailed] m GHCupInfo
getDownloads urlSource = do
lift $ $(logDebug) [i|Receiving download info from: #{urlSource}|]
case urlSource of
GHCupURL -> do
bs <- reThrowAll DownloadFailed $ smartDl ghcupURL
lE' JSONDecodeError $ bimap show id $ Y.decodeEither' (L.toStrict bs)
(OwnSource url) -> do
bs <- reThrowAll DownloadFailed $ downloadBS url
lE' JSONDecodeError $ bimap show id $ Y.decodeEither' (L.toStrict bs)
(OwnSpec av) -> pure $ av
mergeGhcupInfo :: GHCupInfo -- ^ base to merge with
-> GHCupInfo -- ^ extension overwriting the base
-> GHCupInfo
mergeGhcupInfo (GHCupInfo tr base) (GHCupInfo _ ext) =
let new = M.mapWithKey (\k a -> case M.lookup k ext of
Just a' -> M.union a' a
Nothing -> a
) base
in GHCupInfo tr new
where
-- First check if the json file is in the ~/.ghcup/cache dir
-- and check it's access time. If it has been accessed within the
-- last 5 minutes, just reuse it.
@@ -292,7 +293,8 @@ getDownloadInfo t v (PlatformRequest a p mv) dls = maybe
(case p of
-- non-musl won't work on alpine
Linux Alpine -> with_distro <|> without_distro_ver
_ -> with_distro <|> without_distro_ver <|> without_distro)
_ -> with_distro <|> without_distro_ver <|> without_distro
)
where
with_distro = distro_preview id id
@@ -300,7 +302,18 @@ getDownloadInfo t v (PlatformRequest a p mv) dls = maybe
without_distro = distro_preview (set _Linux UnknownLinux) (const Nothing)
distro_preview f g =
preview (ix t % ix v % viArch % ix a % ix (f p) % ix (g mv)) dls
let platformVersionSpec =
preview (ix t % ix v % viArch % ix a % ix (f p)) dls
mv' = g mv
in fmap snd
. find
(\(mverRange, _) -> maybe
(mv' == Nothing)
(\range -> maybe False (flip versionRange range) mv')
mverRange
)
. M.toList
=<< platformVersionSpec
-- | Tries to download from the given http or https url

View File

@@ -14,8 +14,10 @@ module GHCup.Requirements where
import GHCup.Types
import GHCup.Types.JSON ( )
import GHCup.Types.Optics
import GHCup.Version
import Control.Applicative
import Data.List ( find )
import Data.Maybe
import Optics
import Prelude hiding ( abs
@@ -23,6 +25,7 @@ import Prelude hiding ( abs
, writeFile
)
import qualified Data.Map.Strict as M
import qualified Data.Text as T
@@ -33,15 +36,25 @@ getCommonRequirements :: PlatformResult
-> ToolRequirements
-> Maybe Requirements
getCommonRequirements pr tr =
preview (ix GHC % ix Nothing % ix (_platform pr) % ix (_distroVersion pr)) tr
<|> preview (ix GHC % ix Nothing % ix (_platform pr) % ix Nothing) tr
<|> preview
( ix GHC
% ix Nothing
% ix (set _Linux UnknownLinux $ _platform pr)
% ix Nothing
)
tr
with_distro <|> without_distro_ver <|> without_distro
where
with_distro = distro_preview _platform _distroVersion
without_distro_ver = distro_preview _platform (const Nothing)
without_distro = distro_preview (set _Linux UnknownLinux . _platform) (const Nothing)
distro_preview f g =
let platformVersionSpec =
preview (ix GHC % ix Nothing % ix (f pr)) tr
mv' = g pr
in fmap snd
. find
(\(mverRange, _) -> maybe
(mv' == Nothing)
(\range -> maybe False (flip versionRange range) mv')
mverRange
)
. M.toList
=<< platformVersionSpec
prettyRequirements :: Requirements -> T.Text

View File

@@ -14,6 +14,7 @@ Portability : POSIX
module GHCup.Types where
import Data.Map.Strict ( Map )
import Data.List.NonEmpty ( NonEmpty (..) )
import Data.Text ( Text )
import Data.Versions
import HPath
@@ -46,7 +47,7 @@ data GHCupInfo = GHCupInfo
type ToolRequirements = Map Tool ToolReqVersionSpec
type ToolReqVersionSpec = Map (Maybe Version) PlatformReqSpec
type PlatformReqSpec = Map Platform PlatformReqVersionSpec
type PlatformReqVersionSpec = Map (Maybe Versioning) Requirements
type PlatformReqVersionSpec = Map (Maybe VersionRange) Requirements
data Requirements = Requirements
@@ -70,7 +71,7 @@ type GHCupDownloads = Map Tool ToolVersionSpec
type ToolVersionSpec = Map Version VersionInfo
type ArchitectureSpec = Map Architecture PlatformSpec
type PlatformSpec = Map Platform PlatformVersionSpec
type PlatformVersionSpec = Map (Maybe Versioning) DownloadInfo
type PlatformVersionSpec = Map (Maybe VersionRange) DownloadInfo
-- | An installable tool.
@@ -191,6 +192,7 @@ data TarDir = RealDir (Path Rel)
data URLSource = GHCupURL
| OwnSource URI
| OwnSpec GHCupInfo
| AddSource (Either GHCupInfo URI) -- ^ merge with GHCupURL
deriving (GHC.Generic, Show)
@@ -201,11 +203,12 @@ data UserSettings = UserSettings
, uKeepDirs :: Maybe KeepDirs
, uDownloader :: Maybe Downloader
, uKeyBindings :: Maybe UserKeyBindings
, uUrlSource :: Maybe URLSource
}
deriving (Show, GHC.Generic)
defaultUserSettings :: UserSettings
defaultUserSettings = UserSettings Nothing Nothing Nothing Nothing Nothing Nothing
defaultUserSettings = UserSettings Nothing Nothing Nothing Nothing Nothing Nothing Nothing
data UserKeyBindings = UserKeyBindings
{ kUp :: Maybe Vty.Key
@@ -255,6 +258,7 @@ data Settings = Settings
, keepDirs :: KeepDirs
, downloader :: Downloader
, verbose :: Bool
, urlSource :: URLSource
}
deriving (Show, GHC.Generic)
@@ -304,7 +308,7 @@ data PlatformResult = PlatformResult
prettyPlatform :: PlatformResult -> String
prettyPlatform PlatformResult { _platform = plat, _distroVersion = Just v' }
= show plat <> ", " <> show v'
= show plat <> ", " <> T.unpack (prettyV v')
prettyPlatform PlatformResult { _platform = plat, _distroVersion = Nothing }
= show plat
@@ -341,3 +345,19 @@ prettyTVer :: GHCTargetVersion -> Text
prettyTVer (GHCTargetVersion (Just t) v') = t <> "-" <> prettyVer v'
prettyTVer (GHCTargetVersion Nothing v') = prettyVer v'
-- | A comparator and a version.
data VersionCmp = VR_gt Versioning
| VR_gteq Versioning
| VR_lt Versioning
| VR_lteq Versioning
| VR_eq Versioning
deriving (Eq, GHC.Generic, Ord, Show)
-- | A version range. Supports && and ||, but not arbitrary
-- combinations. This is a little simplified.
data VersionRange = SimpleRange (NonEmpty VersionCmp) -- And
| OrRange (NonEmpty VersionCmp) VersionRange
deriving (Eq, GHC.Generic, Ord, Show)

View File

@@ -22,22 +22,28 @@ Portability : POSIX
module GHCup.Types.JSON where
import GHCup.Types
import GHCup.Utils.MegaParsec
import GHCup.Utils.Prelude
import Control.Applicative ( (<|>) )
import Data.Aeson
import Data.Aeson.TH
import Data.Aeson.Types
import Data.List.NonEmpty ( NonEmpty(..) )
import Data.Text.Encoding as E
import Data.Versions
import Data.Void
import Data.Word8
import HPath
import URI.ByteString
import Text.Casing
import qualified Data.ByteString as BS
import qualified Data.List.NonEmpty as NE
import qualified Data.Text as T
import qualified Graphics.Vty as Vty
import qualified Text.Megaparsec as MP
import qualified Text.Megaparsec.Char as MPC
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } { fieldLabelModifier = removeLensFieldLabel } ''Architecture
@@ -55,6 +61,7 @@ deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''GHCupI
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''Requirements
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''KeepDirs
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''Downloader
deriveJSON defaultOptions { sumEncoding = ObjectWithSingleField } ''URLSource
deriveJSON defaultOptions { fieldLabelModifier = \str' -> maybe str' T.unpack . T.stripPrefix (T.pack "u-") . T.pack . kebab $ str' } ''UserSettings
deriveJSON defaultOptions { fieldLabelModifier = \str' -> maybe str' T.unpack . T.stripPrefix (T.pack "k-") . T.pack . kebab $ str' } ''UserKeyBindings
deriveJSON defaultOptions { sumEncoding = ObjectWithSingleField } ''Vty.Key
@@ -110,10 +117,10 @@ instance ToJSONKey (Maybe Versioning) where
instance FromJSONKey (Maybe Versioning) where
fromJSONKey = FromJSONKeyTextParser $ \t ->
if t == T.pack "unknown_versioning" then pure Nothing else pure $ just t
if t == T.pack "unknown_versioning" then pure Nothing else just t
where
just t = case versioning t of
Right x -> pure x
Right x -> pure $ Just x
Left e -> fail $ "Failure in (Maybe Versioning) (FromJSONKey)" <> show e
instance ToJSONKey Platform where
@@ -156,10 +163,10 @@ instance ToJSONKey (Maybe Version) where
instance FromJSONKey (Maybe Version) where
fromJSONKey = FromJSONKeyTextParser $ \t ->
if t == T.pack "unknown_version" then pure Nothing else pure $ just t
if t == T.pack "unknown_version" then pure Nothing else just t
where
just t = case version t of
Right x -> pure x
Right x -> pure $ Just x
Left e -> fail $ "Failure in (Maybe Version) (FromJSONKey)" <> show e
instance ToJSON Version where
@@ -219,3 +226,101 @@ instance FromJSON TarDir where
regexDir = withObject "TarDir" $ \o -> do
r <- o .: "RegexDir"
pure $ RegexDir r
instance ToJSON VersionCmp where
toJSON = String . versionCmpToText
instance FromJSON VersionCmp where
parseJSON = withText "VersionCmp" $ \t -> do
case MP.parse versionCmpP "" t of
Right r -> pure r
Left e -> fail (MP.errorBundlePretty e)
versionCmpToText :: VersionCmp -> T.Text
versionCmpToText (VR_gt ver') = "> " <> prettyV ver'
versionCmpToText (VR_gteq ver') = ">= " <> prettyV ver'
versionCmpToText (VR_lt ver') = "< " <> prettyV ver'
versionCmpToText (VR_lteq ver') = "<= " <> prettyV ver'
versionCmpToText (VR_eq ver') = "== " <> prettyV ver'
versionCmpP :: MP.Parsec Void T.Text VersionCmp
versionCmpP =
fmap VR_gt (MP.try $ MPC.space *> MP.chunk ">" *> MPC.space *> versioningEnd)
<|> fmap
VR_gteq
(MP.try $ MPC.space *> MP.chunk ">=" *> MPC.space *> versioningEnd)
<|> fmap
VR_lt
(MP.try $ MPC.space *> MP.chunk "<" *> MPC.space *> versioningEnd)
<|> fmap
VR_lteq
(MP.try $ MPC.space *> MP.chunk "<=" *> MPC.space *> versioningEnd)
<|> fmap
VR_eq
(MP.try $ MPC.space *> MP.chunk "==" *> MPC.space *> versioningEnd)
<|> fmap
VR_eq
(MP.try $ MPC.space *> versioningEnd)
instance ToJSON VersionRange where
toJSON = String . verRangeToText
verRangeToText :: VersionRange -> T.Text
verRangeToText (SimpleRange cmps) =
let inner = foldr1 (\x y -> x <> " && " <> y)
(versionCmpToText <$> NE.toList cmps)
in "( " <> inner <> " )"
verRangeToText (OrRange cmps range) =
let left = verRangeToText $ (SimpleRange cmps)
right = verRangeToText range
in left <> " || " <> right
instance FromJSON VersionRange where
parseJSON = withText "VersionRange" $ \t -> do
case MP.parse versionRangeP "" t of
Right r -> pure r
Left e -> fail (MP.errorBundlePretty e)
versionRangeP :: MP.Parsec Void T.Text VersionRange
versionRangeP = go <* MP.eof
where
go =
MP.try orParse
<|> MP.try (fmap SimpleRange andParse)
<|> (fmap (SimpleRange . pure) versionCmpP)
orParse :: MP.Parsec Void T.Text VersionRange
orParse =
(\a o -> OrRange a o)
<$> (MP.try andParse <|> fmap pure versionCmpP)
<*> (MPC.space *> MP.chunk "||" *> MPC.space *> go)
andParse :: MP.Parsec Void T.Text (NonEmpty VersionCmp)
andParse =
fmap (\h t -> h :| t)
(MPC.space *> MP.chunk "(" *> MPC.space *> versionCmpP)
<*> ( MP.try
$ MP.many (MPC.space *> MP.chunk "&&" *> MPC.space *> versionCmpP)
)
<* MPC.space
<* MP.chunk ")"
<* MPC.space
versioningEnd :: MP.Parsec Void T.Text Versioning
versioningEnd =
MP.try (verP (MP.chunk " " <|> MP.chunk ")" <|> MP.chunk "&&") <* MPC.space)
<|> versioning'
instance ToJSONKey (Maybe VersionRange) where
toJSONKey = toJSONKeyText $ \case
Just x -> verRangeToText x
Nothing -> "unknown_versioning"
instance FromJSONKey (Maybe VersionRange) where
fromJSONKey = FromJSONKeyTextParser $ \t ->
if t == T.pack "unknown_versioning" then pure Nothing else just t
where
just t = case MP.parse versionRangeP "" t of
Right x -> pure $ Just x
Left e -> fail $ "Failure in (Maybe VersionRange) (FromJSONKey)" <> MP.errorBundlePretty e

View File

@@ -112,33 +112,40 @@ ghcLinkDestination tool ver = do
-- | Removes the minor GHC symlinks, e.g. ghc-8.6.5.
rmMinorSymlinks :: (MonadReader AppState m, MonadIO m, MonadLogger m) => GHCTargetVersion -> m ()
rmMinorSymlinks GHCTargetVersion {..} = do
AppState { dirs = Dirs {..} } <- ask
files <- liftIO $ findFiles'
binDir
( maybe mempty (\x -> MP.chunk (x <> "-")) _tvTarget
*> parseUntil1 (MP.chunk $ prettyVer _tvVersion)
*> (MP.chunk $ prettyVer _tvVersion)
*> MP.eof
)
rmMinorSymlinks :: ( MonadReader AppState m
, MonadIO m
, MonadLogger m
, MonadThrow m
, MonadFail m
, MonadReader AppState m
)
=> GHCTargetVersion
-> Excepts '[NotInstalled] m ()
rmMinorSymlinks tv@(GHCTargetVersion {..}) = do
AppState { dirs = Dirs {..} } <- lift ask
files <- liftE $ ghcToolFiles tv
forM_ files $ \f -> do
let fullF = (binDir </> f)
$(logDebug) [i|rm -f #{toFilePath fullF}|]
f_xyz <- liftIO $ parseRel (toFilePath f <> B.singleton _hyphen <> verToBS _tvVersion)
let fullF = (binDir </> f_xyz)
lift $ $(logDebug) [i|rm -f #{toFilePath fullF}|]
liftIO $ hideError doesNotExistErrorType $ deleteFile fullF
-- | Removes the set ghc version for the given target, if any.
rmPlain :: (MonadReader AppState m, MonadLogger m, MonadThrow m, MonadFail m, MonadIO m)
=> Maybe Text -- ^ target
rmPlain :: ( MonadReader AppState m
, MonadLogger m
, MonadThrow m
, MonadFail m
, MonadIO m
)
=> Maybe Text -- ^ target
-> Excepts '[NotInstalled] m ()
rmPlain target = do
AppState { dirs = Dirs {..} } <- lift ask
mtv <- lift $ ghcSet target
mtv <- lift $ ghcSet target
forM_ mtv $ \tv -> do
files <- liftE $ ghcToolFiles tv
files <- liftE $ ghcToolFiles tv
forM_ files $ \f -> do
let fullF = (binDir </> f)
lift $ $(logDebug) [i|rm -f #{toFilePath fullF}|]
@@ -150,25 +157,25 @@ rmPlain target = do
-- | Remove the major GHC symlink, e.g. ghc-8.6.
rmMajorSymlinks :: (MonadReader AppState m, MonadThrow m, MonadLogger m, MonadIO m)
rmMajorSymlinks :: ( MonadReader AppState m
, MonadIO m
, MonadLogger m
, MonadThrow m
, MonadFail m
, MonadReader AppState m
)
=> GHCTargetVersion
-> m ()
rmMajorSymlinks GHCTargetVersion {..} = do
AppState { dirs = Dirs {..} } <- ask
-> Excepts '[NotInstalled] m ()
rmMajorSymlinks tv@(GHCTargetVersion {..}) = do
AppState { dirs = Dirs {..} } <- lift ask
(mj, mi) <- getMajorMinorV _tvVersion
let v' = intToText mj <> "." <> intToText mi
files <- liftIO $ findFiles'
binDir
( maybe mempty (\x -> MP.chunk (x <> "-")) _tvTarget
*> parseUntil1 (MP.chunk v')
*> MP.chunk v'
*> MP.eof
)
files <- liftE $ ghcToolFiles tv
forM_ files $ \f -> do
let fullF = (binDir </> f)
$(logDebug) [i|rm -f #{toFilePath fullF}|]
f_xyz <- liftIO $ parseRel (toFilePath f <> B.singleton _hyphen <> E.encodeUtf8 v')
let fullF = (binDir </> f_xyz)
lift $ $(logDebug) [i|rm -f #{toFilePath fullF}|]
liftIO $ hideError doesNotExistErrorType $ deleteFile fullF

View File

@@ -440,13 +440,16 @@ isBrokenSymlink p =
pure False
chmod_777 :: (MonadLogger m, MonadIO m) => Path a -> m ()
chmod_777 (toFilePath -> fp) = do
chmod_755 :: (MonadLogger m, MonadIO m) => Path a -> m ()
chmod_755 (toFilePath -> fp) = do
let exe_mode =
newFilePerms
nullFileMode
`unionFileModes` ownerExecuteMode
`unionFileModes` ownerReadMode
`unionFileModes` ownerWriteMode
`unionFileModes` groupExecuteMode
`unionFileModes` groupReadMode
`unionFileModes` otherExecuteMode
$(logDebug) [i|chmod 777 #{fp}|]
`unionFileModes` otherReadMode
$(logDebug) [i|chmod 755 #{fp}|]
liftIO $ setFileMode fp exe_mode

View File

@@ -74,13 +74,13 @@ ghcTargetBinP t =
ghcTargetVerP :: MP.Parsec Void Text GHCTargetVersion
ghcTargetVerP =
(\x y -> GHCTargetVersion x y)
<$> (MP.try (Just <$> (parseUntil1 (MP.chunk "-" *> verP)) <* MP.chunk "-")
<$> (MP.try (Just <$> (parseUntil1 (MP.chunk "-" *> verP')) <* MP.chunk "-")
<|> (flip const Nothing <$> mempty)
)
<*> (version' <* MP.eof)
where
verP :: MP.Parsec Void Text Text
verP = do
verP' :: MP.Parsec Void Text Text
verP' = do
v <- version'
let startsWithDigists =
and
@@ -97,3 +97,16 @@ ghcTargetVerP =
if startsWithDigists && not (isJust (_vEpoch v))
then pure $ prettyVer v
else fail "Oh"
verP :: MP.Parsec Void Text Text -> MP.Parsec Void Text Versioning
verP suffix = do
ver <- parseUntil suffix
if T.null ver
then fail "empty version"
else do
rest <- MP.getInput
MP.setInput ver
v <- versioning'
MP.setInput rest
pure v

View File

@@ -3,7 +3,7 @@
{-|
Module : GHCup.Version
Description : Static version information
Description : Version information and version handling.
Copyright : (c) Julian Ospald, 2020
License : LGPL-3.0
Maintainer : hasufell@hasufell.de
@@ -13,6 +13,7 @@ Portability : POSIX
module GHCup.Version where
import GHCup.Utils.Version.QQ
import GHCup.Types
import Data.Versions
import URI.ByteString
@@ -22,7 +23,7 @@ import qualified Data.Text as T
-- | This reflects the API version of the YAML.
ghcupURL :: URI
ghcupURL = [uri|https://www.haskell.org/ghcup/data/ghcup-0.0.3.yaml|]
ghcupURL = [uri|https://www.haskell.org/ghcup/data/ghcup-0.0.4.yaml|]
-- | The current ghcup version.
ghcUpVer :: PVP
@@ -31,3 +32,16 @@ ghcUpVer = [pver|0.1.12|]
-- | ghcup version as numeric string.
numericVer :: String
numericVer = T.unpack . prettyPVP $ ghcUpVer
versionCmp :: Versioning -> VersionCmp -> Bool
versionCmp ver1 (VR_gt ver2) = ver1 > ver2
versionCmp ver1 (VR_gteq ver2) = ver1 >= ver2
versionCmp ver1 (VR_lt ver2) = ver1 < ver2
versionCmp ver1 (VR_lteq ver2) = ver1 <= ver2
versionCmp ver1 (VR_eq ver2) = ver1 == ver2
versionRange :: Versioning -> VersionRange -> Bool
versionRange ver' (SimpleRange cmps) = and $ fmap (versionCmp ver') cmps
versionRange ver' (OrRange cmps range) =
versionRange ver' (SimpleRange cmps) || versionRange ver' range

View File

@@ -159,6 +159,18 @@ instance Arbitrary VersionInfo where
arbitrary = genericArbitrary
shrink = genericShrink
instance Arbitrary VersionRange where
arbitrary = genericArbitrary
shrink = genericShrink
instance Arbitrary (NonEmpty VersionCmp) where
arbitrary = genericArbitrary
shrink = genericShrink
instance Arbitrary VersionCmp where
arbitrary = genericArbitrary
shrink = genericShrink
instance Arbitrary (Path Rel) where
arbitrary =
(either (error . show) id . parseRel . E.encodeUtf8 . T.pack)