Compare commits
29 Commits
v0.1.12-rc
...
chmod-fix
| Author | SHA1 | Date | |
|---|---|---|---|
| b0f90c096f | |||
| e8361c564a | |||
|
|
54db9c9a92 | ||
|
|
73db341dc8 | ||
| 5fd30b412b | |||
|
|
bbe2e87640 | ||
|
|
67f59f6895 | ||
|
|
3e2df2e111 | ||
| 824d2149c6 | |||
|
|
c86dbe043b | ||
|
|
8043ac7f51 | ||
| b20371c3ac | |||
| 0589a7cbcc | |||
| cf48961063 | |||
| 6046582b9c | |||
| 82aa6c70ea | |||
| e829bd8235 | |||
| 66f989e691 | |||
| eebb91fbb0 | |||
| 1d3e88bdfe | |||
| fbb03dee7e | |||
|
|
88e5afb70f | ||
| 67eabfd3af | |||
| cd1dd8c29e | |||
| 08ddb591b7 | |||
| 3e841b3c68 | |||
| 53f5a08924 | |||
| d368863c3d | |||
| c76cce5830 |
@@ -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:
|
||||
|
||||
14
CHANGELOG.md
14
CHANGELOG.md
@@ -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
|
||||
|
||||
|
||||
43
README.md
43
README.md
@@ -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
|
||||
|
||||
|
||||
@@ -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 ())
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
61
config.yaml
Normal 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"
|
||||
@@ -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
1446
ghcup-0.0.4.yaml
Normal file
File diff suppressed because it is too large
Load Diff
@@ -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
|
||||
|
||||
23326
golden/GHCupInfo.json
23326
golden/GHCupInfo.json
File diff suppressed because it is too large
Load Diff
38
lib/GHCup.hs
38
lib/GHCup.hs
@@ -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
|
||||
|
||||
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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)
|
||||
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
|
||||
|
||||
@@ -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
|
||||
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
|
||||
@@ -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)
|
||||
|
||||
Reference in New Issue
Block a user