Skip to content

Commit

Permalink
Merge branch 'improve-stack-setup-use'
Browse files Browse the repository at this point in the history
  • Loading branch information
hasufell committed Oct 25, 2023
2 parents 38cd5ad + c7439d3 commit d85accb
Show file tree
Hide file tree
Showing 19 changed files with 412 additions and 373 deletions.
8 changes: 5 additions & 3 deletions app/ghcup/BrickMain.hs
Original file line number Diff line number Diff line change
Expand Up @@ -11,7 +11,7 @@ module BrickMain where
import GHCup
import GHCup.Download
import GHCup.Errors
import GHCup.Types.Optics ( getDirs )
import GHCup.Types.Optics ( getDirs, getPlatformReq )
import GHCup.Types hiding ( LeanAppState(..) )
import GHCup.Utils
import GHCup.OptParse.Common (logGHCPostRm)
Expand Down Expand Up @@ -660,8 +660,10 @@ getGHCupInfo = do

r <-
flip runReaderT settings
. runE @'[DigestError, ContentLengthError, GPGError, JSONError , DownloadFailed , FileDoesNotExistError]
$ liftE getDownloadsF
. runE @'[DigestError, ContentLengthError, GPGError, JSONError , DownloadFailed , FileDoesNotExistError, StackPlatformDetectError]
$ do
pfreq <- lift getPlatformReq
liftE $ getDownloadsF pfreq

case r of
VRight a -> pure $ Right a
Expand Down
17 changes: 7 additions & 10 deletions app/ghcup/Main.hs
Original file line number Diff line number Diff line change
Expand Up @@ -42,7 +42,6 @@ import Data.Aeson.Encode.Pretty ( encodePretty )
import Data.Either
import Data.Functor
import Data.Maybe
import Data.Versions
import GHC.IO.Encoding
import Haskus.Utils.Variant.Excepts
import Language.Haskell.TH
Expand Down Expand Up @@ -85,13 +84,11 @@ toSettings options = do
keepDirs = fromMaybe (fromMaybe (Types.keepDirs defaultSettings) uKeepDirs) optKeepDirs
downloader = fromMaybe (fromMaybe defaultDownloader uDownloader) optsDownloader
keyBindings = maybe defaultKeyBindings mergeKeys uKeyBindings
urlSource = maybe (fromMaybe (Types.urlSource defaultSettings) uUrlSource) (OwnSource . (:[]) . Right) optUrlSource
urlSource = fromMaybe (fromMaybe (Types.urlSource defaultSettings) uUrlSource) optUrlSource
noNetwork = fromMaybe (fromMaybe (Types.noNetwork defaultSettings) uNoNetwork) optNoNetwork
gpgSetting = fromMaybe (fromMaybe (Types.gpgSetting defaultSettings) uGPGSetting) optGpg
platformOverride = optPlatform <|> (uPlatformOverride <|> Types.platformOverride defaultSettings)
mirrors = fromMaybe (Types.mirrors defaultSettings) uMirrors
stackSetupSource = fromMaybe (Types.stackSetupSource defaultSettings) uStackSetupSource
stackSetup = fromMaybe (Types.stackSetup defaultSettings) uStackSetup
in (Settings {..}, keyBindings)
#if defined(INTERNAL_DOWNLOADER)
defaultDownloader = Internal
Expand Down Expand Up @@ -213,10 +210,9 @@ Report bugs at <https://github.com/haskell/ghcup-hs/issues>|]
exitWith (ExitFailure 2)

ghcupInfo <-
( flip runReaderT leanAppstate
. runE @'[DigestError, ContentLengthError, GPGError, JSONError , DownloadFailed, FileDoesNotExistError]
$ liftE getDownloadsF
)
( flip runReaderT leanAppstate . runE @'[ContentLengthError, DigestError, DistroNotFound, DownloadFailed, FileDoesNotExistError, GPGError, JSONError, NoCompatibleArch, NoCompatiblePlatform, NoDownload, GHCup.Errors.ParseError, ProcessError, UnsupportedSetupCombo, StackPlatformDetectError] $ do
liftE $ getDownloadsF pfreq
)
>>= \case
VRight r -> pure r
VLeft e -> do
Expand Down Expand Up @@ -341,8 +337,8 @@ Report bugs at <https://github.com/haskell/ghcup-hs/issues>|]
, NextVerNotFound
, NoToolVersionSet
] m Bool
alreadyInstalling (Install (Right InstallGHCOptions{..})) (GHC, ver) = cmp' GHC instVer ver
alreadyInstalling (Install (Left (InstallGHC InstallGHCOptions{..}))) (GHC, ver) = cmp' GHC instVer ver
alreadyInstalling (Install (Right InstallOptions{..})) (GHC, ver) = cmp' GHC instVer ver
alreadyInstalling (Install (Left (InstallGHC InstallOptions{..}))) (GHC, ver) = cmp' GHC instVer ver
alreadyInstalling (Install (Left (InstallCabal InstallOptions{..}))) (Cabal, ver) = cmp' Cabal instVer ver
alreadyInstalling (Install (Left (InstallHLS InstallOptions{..}))) (HLS, ver) = cmp' HLS instVer ver
alreadyInstalling (Install (Left (InstallStack InstallOptions{..}))) (Stack, ver) = cmp' Stack instVer ver
Expand Down Expand Up @@ -380,3 +376,4 @@ Report bugs at <https://github.com/haskell/ghcup-hs/issues>|]
cmp' tool instVer ver = do
(v, _) <- liftE $ fromVersion instVer tool
pure (v == ver)

74 changes: 33 additions & 41 deletions data/config.yaml
Original file line number Diff line number Diff line change
Expand Up @@ -51,53 +51,45 @@ meta-cache: 300 # in seconds
# 2. Strict: fail hard
meta-mode: Lax # Strict | Lax

# Where to get GHC/cabal/hls download info/versions from. For more detailed explanation
# check the 'URLSource' type in the code.
# Where to get GHC/cabal/hls download info/versions from. This is a list that performs
# union over tool versions, preferring the later entries.
url-source:
## Use the internal download uri, this is the default
GHCupURL: []
- GHCupURL

## Example 1: Read download info from this location instead
## Accepts file/http/https scheme
## Can also be an array of URLs or an array of 'Either GHCupInfo URL', in
## which case they are merged right-biased (overwriting duplicate versions).
# OwnSource: "file:///home/jule/git/ghcup-hs/ghcup-0.0.3.yaml"
## Prefer stack supplied metadata (will still use GHCup metadata for versions not existing in stack metadata)
# - StackSetupURL

## Example 2: Add custom tarballs to the default downloads, overwriting duplicate versions.
## Can also be an array of 'Either GHCupInfo URL', also see Example 3.
# AddSource:
# Left:
# globalTools: {}
# toolRequirements: {}
# 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
## Add pre-release channel
# - https://raw.githubusercontent.com/haskell/ghcup-metadata/master/ghcup-prereleases-0.0.7.yaml
## Add nightly channel
# - https://ghc.gitlab.haskell.org/ghcup-metadata/ghcup-nightlies-0.0.7.yaml
## Add cross compiler channel
# - https://raw.githubusercontent.com/haskell/ghcup-metadata/master/ghcup-cross-0.0.8.yaml

## Example 3: Add multiple custom download files to the default downloads via right-biased merge (overwriting duplicate
## versions).
# AddSource:
# - Right: "file:///home/jule/git/ghcup-hs/ghcup-prereleases.yaml"
# - Right: "file:///home/jule/git/ghcup-hs/ghcup-custom.yaml"

# For stack's setup-info, this works similar, e.g.:
# stack-setup-source:
# AddSource:
# - Left:
# ghc:
# linux64-tinfo6:
# 9.4.7:
# url: "https://downloads.haskell.org/~ghc/9.4.7/ghc-9.4.7-x86_64-fedora27-linux.tar.xz"
# content-length: 179117892
# sha256: 216b76b7c6383e6ad9ba82533f323f8550e52893a8b9fa33c7b9dc4201ac766a
## Use dwarf bindist for 9.4.7 for ghcup metadata
# - ghcup-info:
# ghcupDownloads:
# GHC:
# 9.4.7:
# viTags: []
# viArch:
# A_64:
# Linux_UnknownLinux:
# unknown_versioning:
# dlUri: https://downloads.haskell.org/ghc/9.4.7/ghc-9.4.7-x86_64-deb10-linux-dwarf.tar.xz
# dlSubdir:
# RegexDir: "ghc-.*"
# dlHash: b261b3438ba455e3cf757f9c8dc3a06fdc061ea8ec287a65b7809e25fe18bad4

## for stack metadata and the linux64-tinfo6 bindists, use static alpine for 9.8.1
# - setup-info:
# ghc:
# linux64-tinfo6:
# 9.8.1:
# url: "https://downloads.haskell.org/~ghc/9.8.1/ghc-9.8.1-x86_64-alpine3_12-linux-static.tar.xz"
# content-length: 229037440
# sha256: b48f3d3a508d0c140d1c801e04afc65e80c0d25e7e939a8a41edb387b26b81b3

# This is a way to override platform detection, e.g. when you're running
# a Ubuntu derivate based on 18.04, you could do:
Expand Down
32 changes: 19 additions & 13 deletions docs/guide.md
Original file line number Diff line number Diff line change
Expand Up @@ -153,8 +153,7 @@ To use a mirror, set the following option in `~/.ghcup/config.yaml`:

```yml
url-source:
# Accepts file/http/https scheme
OwnSource: "https://some-url/ghcup-0.0.6.yaml"
- https://some-url/ghcup-0.0.6.yaml
```

See [config.yaml](https://github.com/haskell/ghcup-hs/blob/master/data/config.yaml)
Expand Down Expand Up @@ -184,8 +183,8 @@ This will result in `~/.ghcup/config.yaml` to contain this record:

```yml
url-source:
AddSource:
- Right: https://raw.githubusercontent.com/haskell/ghcup-metadata/master/ghcup-prereleases-0.0.7.yaml
- GHCupURL
- https://raw.githubusercontent.com/haskell/ghcup-metadata/master/ghcup-prereleases-0.0.7.yaml
```

You can add as many channels as you like. They are combined under *Last*, so versions from the prerelease channel
Expand All @@ -195,14 +194,13 @@ To remove the channel, delete the entire `url-source` section or set it back to

```yml
url-source:
GHCupURL: []
- GHCupURL
```

If you want to combine your release channel with a mirror, you'd do it like so:

```yml
url-source:
OwnSource:
# base metadata
- "https://mirror.sjtu.edu.cn/ghcup/yaml/ghcup/data/ghcup-0.0.6.yaml"
# prerelease channel
Expand Down Expand Up @@ -249,24 +247,32 @@ stack config set system-ghc true --global
### Using stack's setup-info metadata to install GHC

You can now use stack's [setup-info metadata](https://github.com/commercialhaskell/stackage-content/blob/master/stack/stack-setup-2.yaml)
to install GHC. For that, you can invoke ghcup like so:
to install GHC. For that, you can invoke ghcup like so as a shorthand:

```sh
ghcup install ghc --stack-setup 9.4.7
# ghcup will only see GHC now
ghcup -s StackSetupURL install ghc 9.4.7
# this combines both ghcup and stack metadata
ghcup -s '["GHCupURL", "StackSetupURL"]' install ghc 9.4.7
```

To make this permanent, you can add the following to you `~/.ghcup/config.yaml`:
To make this permanent and combine it with the GHCup metadata, you can add the following to your `~/.ghcup/config.yaml`:

```yaml
stack-setup: true
url-source:
- GHCupURL
# stack versions take precedence
# you'll still have access to GHCup provided versions and tools in case they don't exist in stack metadata
- StackSetupURL
```

You can customize or add sections to the setup-info similar to how the [stack documentation](https://docs.haskellstack.org/en/stable/yaml_configuration/#setup-info) explains it. E.g. to change the 9.4.7 bindist, you might do:

```yaml
stack-setup-source:
AddSource:
- Left:
url-source:
- GHCupURL
- StackSetupURL
- setup-info:
ghc:
linux64-tinfo6:
9.4.7:
Expand Down
21 changes: 9 additions & 12 deletions lib-opt/GHCup/OptParse.hs
Original file line number Diff line number Diff line change
Expand Up @@ -57,16 +57,13 @@ import GHCup.Types
import Control.Monad.Fail ( MonadFail )
#endif
import Control.Monad.Reader
import Data.Bifunctor
import Data.Either
import Data.Functor
import Data.Maybe
import Options.Applicative hiding ( style )
import Options.Applicative.Help.Pretty ( text )
import Prelude hiding ( appendFile )
import URI.ByteString

import qualified Data.ByteString.UTF8 as UTF8


data Options = Options
Expand All @@ -77,18 +74,19 @@ data Options = Options
, optMetaCache :: Maybe Integer
, optMetaMode :: Maybe MetaMode
, optPlatform :: Maybe PlatformRequest
, optUrlSource :: Maybe URI
, optUrlSource :: Maybe URLSource
, optNoVerify :: Maybe Bool
, optKeepDirs :: Maybe KeepDirs
, optsDownloader :: Maybe Downloader
, optNoNetwork :: Maybe Bool
, optGpg :: Maybe GPGSetting
, optStackSetup :: Maybe Bool
-- commands
, optCommand :: Command
}

data Command
= Install (Either InstallCommand InstallGHCOptions)
= Install (Either InstallCommand InstallOptions)
| Test TestCommand
| InstallCabalLegacy InstallOptions
| Set (Either SetCommand SetOptions)
Expand Down Expand Up @@ -134,13 +132,13 @@ opts =
)
<*> optional
(option
(eitherReader parseUri)
(eitherReader parseUrlSource)
( short 's'
<> long "url-source"
<> metavar "URL"
<> help "Alternative ghcup download info url"
<> metavar "URL_SOURCE"
<> help "Alternative ghcup download info"
<> internal
<> completer fileUri
<> completer urlSourceCompleter
)
)
<*> (fmap . fmap) not (invertableSwitch "verify" (Just 'n') True (help "Disable tarball checksum verification (default: enabled)"))
Expand Down Expand Up @@ -178,10 +176,9 @@ opts =
"GPG verification (default: none)"
<> completer (listCompleter ["strict", "lax", "none"])
))
<*> invertableSwitch "stack-setup" (Just 's') False (help "Use stack's setup info for discovering and installing GHC versions")
<*> com
where
parseUri s' =
first show $ parseURI strictURIParserOptions (UTF8.fromString s')



com :: Parser Command
Expand Down
41 changes: 33 additions & 8 deletions lib-opt/GHCup/OptParse/Common.hs
Original file line number Diff line number Diff line change
Expand Up @@ -64,6 +64,8 @@ import URI.ByteString
import qualified Data.ByteString.UTF8 as UTF8
import qualified Data.Map.Strict as M
import qualified Data.Text as T
import qualified Data.Text.Lazy.Encoding as LE
import qualified Data.Text.Lazy as LT
import qualified Text.Megaparsec as MP
import qualified System.FilePath.Posix as FP
import GHCup.Version
Expand Down Expand Up @@ -322,6 +324,15 @@ toolCompleter = listCompleter ["ghc", "cabal", "hls", "stack"]
gitFileUri :: [String] -> Completer
gitFileUri add = mkCompleter $ fileUri' (["git://"] <> add)

urlSourceCompleter :: Completer
urlSourceCompleter = mkCompleter $ urlSourceCompleter' []

urlSourceCompleter' :: [String] -> String -> IO [String]
urlSourceCompleter' add str' = do
let static = ["GHCupURL", "StackSetupURL"]
file <- fileUri' add str'
pure $ static ++ file

fileUri :: Completer
fileUri = mkCompleter $ fileUri' []

Expand Down Expand Up @@ -450,13 +461,15 @@ tagCompleter tool add = listIOCompleter $ do
defaultKeyBindings
loggerConfig

mGhcUpInfo <- flip runReaderT appState . runE $ getDownloadsF
case mGhcUpInfo of
VRight ghcupInfo -> do
let allTags = filter (/= Old)
$ _viTags =<< M.elems (availableToolVersions (_ghcupDownloads ghcupInfo) tool)
pure $ nub $ (add ++) $ fmap tagToString allTags
VLeft _ -> pure (nub $ ["recommended", "latest", "latest-prerelease"] ++ add)
mpFreq <- flip runReaderT appState . runE $ platformRequest
forFold mpFreq $ \pfreq -> do
mGhcUpInfo <- flip runReaderT appState . runE $ getDownloadsF pfreq
case mGhcUpInfo of
VRight ghcupInfo -> do
let allTags = filter (/= Old)
$ _viTags =<< M.elems (availableToolVersions (_ghcupDownloads ghcupInfo) tool)
pure $ nub $ (add ++) $ fmap tagToString allTags
VLeft _ -> pure (nub $ ["recommended", "latest", "latest-prerelease"] ++ add)

versionCompleter :: [ListCriteria] -> Tool -> Completer
versionCompleter criteria tool = versionCompleter' criteria tool (const True)
Expand All @@ -477,8 +490,8 @@ versionCompleter' criteria tool filter' = listIOCompleter $ do
defaultKeyBindings
loggerConfig
mpFreq <- flip runReaderT leanAppState . runE $ platformRequest
mGhcUpInfo <- flip runReaderT leanAppState . runE $ getDownloadsF
forFold mpFreq $ \pfreq -> do
mGhcUpInfo <- flip runReaderT leanAppState . runE $ getDownloadsF pfreq
forFold mGhcUpInfo $ \ghcupInfo -> do
let appState = AppState
settings
Expand Down Expand Up @@ -817,3 +830,15 @@ logGHCPostRm ghcVer = do
let storeGhcDir = cabalStore </> ("ghc-" <> T.unpack (prettyVer $ _tvVersion ghcVer))
logInfo $ T.pack $ "After removing GHC you might also want to clean up your cabal store at: " <> storeGhcDir

parseUrlSource :: String -> Either String URLSource
parseUrlSource "GHCupURL" = pure GHCupURL
parseUrlSource "StackSetupURL" = pure StackSetupURL
parseUrlSource s' = (eitherDecode . LE.encodeUtf8 . LT.pack $ s')
<|> (fmap (OwnSource . (:[]) . Right) . first show . parseURI strictURIParserOptions .UTF8.fromString $ s')

parseNewUrlSource :: String -> Either String NewURLSource
parseNewUrlSource "GHCupURL" = pure NewGHCupURL
parseNewUrlSource "StackSetupURL" = pure NewStackSetupURL
parseNewUrlSource s' = (eitherDecode . LE.encodeUtf8 . LT.pack $ s')
<|> (fmap NewURI . first show . parseURI strictURIParserOptions .UTF8.fromString $ s')

Loading

0 comments on commit d85accb

Please sign in to comment.