Compare commits

..

1 Commits

Author SHA1 Message Date
4b7d165b57 Improve logging on broken symlinks wrt #880 2023-09-03 14:35:32 +08:00
56 changed files with 1601 additions and 2162 deletions

View File

@@ -30,32 +30,32 @@ sha_sum "$(raw_eghcup --offline whereis ghcup)"
### Haskell test suite
./"ghcup-test${ext}"
./"ghcup-test-optparse${ext}"
rm "ghcup-test${ext}" "ghcup-test-optparse${ext}"
./ghcup-test${ext}
./ghcup-test-optparse${ext}
rm ghcup-test${ext} ghcup-test-optparse${ext}
### manual cli based testing
eghcup --numeric-version
eghcup install ghc "${GHC_VER}"
eghcup unset ghc "${GHC_VER}"
ls -lah "$(eghcup whereis -d ghc "${GHC_VER}")"
[ "$($(eghcup whereis ghc "${GHC_VER}") --numeric-version)" = "${GHC_VER}" ]
[ "$(eghcup run -q --ghc "${GHC_VER}" -- ghc --numeric-version)" = "${GHC_VER}" ]
[ "$(ghcup run -q --ghc "${GHC_VER}" -- ghc -e 'Control.Monad.join (Control.Monad.fmap System.IO.putStr System.Environment.getExecutablePath)')" = "$($(ghcup whereis ghc "${GHC_VER}") -e 'Control.Monad.join (Control.Monad.fmap System.IO.putStr System.Environment.getExecutablePath)')" ]
eghcup set ghc "${GHC_VER}"
eghcup install cabal "${CABAL_VER}"
[ "$($(eghcup whereis cabal "${CABAL_VER}") --numeric-version)" = "${CABAL_VER}" ]
eghcup install ghc ${GHC_VER}
eghcup unset ghc ${GHC_VER}
ls -lah "$(eghcup whereis -d ghc ${GHC_VER})"
[ "`$(eghcup whereis ghc ${GHC_VER}) --numeric-version`" = "${GHC_VER}" ]
[ "`eghcup run --ghc ${GHC_VER} -- ghc --numeric-version`" = "${GHC_VER}" ]
[ "`ghcup run --ghc ${GHC_VER} -- ghc -e 'Control.Monad.join (Control.Monad.fmap System.IO.putStr System.Environment.getExecutablePath)'`" = "`$(ghcup whereis ghc ${GHC_VER}) -e 'Control.Monad.join (Control.Monad.fmap System.IO.putStr System.Environment.getExecutablePath)'`" ]
eghcup set ghc ${GHC_VER}
eghcup install cabal ${CABAL_VER}
[ "`$(eghcup whereis cabal ${CABAL_VER}) --numeric-version`" = "${CABAL_VER}" ]
eghcup unset cabal
"$GHCUP_BIN"/cabal --version && exit 1 || echo yes
# make sure no cabal is set when running 'ghcup run' to check that PATH propagages properly
# https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/375
[ "$(eghcup run -q --cabal "${CABAL_VER}" -- cabal --numeric-version)" = "${CABAL_VER}" ]
eghcup set cabal "${CABAL_VER}"
[ "`eghcup run --cabal ${CABAL_VER} -- cabal --numeric-version`" = "${CABAL_VER}" ]
eghcup set cabal ${CABAL_VER}
[ "$($(eghcup whereis cabal "${CABAL_VER}") --numeric-version)" = "${CABAL_VER}" ]
[ "`$(eghcup whereis cabal ${CABAL_VER}) --numeric-version`" = "${CABAL_VER}" ]
if [ "${OS}" != "FreeBSD" ] ; then
if [ "${ARCH}" = "64" ] && [ "${DISTRO}" != "Alpine" ] ; then
@@ -85,10 +85,10 @@ eghcup list -t cabal
ghc_ver=$(ghc --numeric-version)
ghc --version
"ghc-${ghc_ver}" --version
ghc-${ghc_ver} --version
if [ "${OS}" != "Windows" ] ; then
ghci --version
"ghci-${ghc_ver}" --version
ghci-${ghc_ver} --version
fi
@@ -132,11 +132,11 @@ else
eghcup --offline set 8.10.3
eghcup set 8.10.3
[ "$(ghc --numeric-version)" = "8.10.3" ]
eghcup set "${GHC_VER}"
eghcup set ${GHC_VER}
[ "$(ghc --numeric-version)" = "${ghc_ver}" ]
eghcup unset ghc
"$GHCUP_BIN"/ghc --numeric-version && exit 1 || echo yes
eghcup set "${GHC_VER}"
eghcup set ${GHC_VER}
eghcup --offline rm 8.10.3
[ "$(ghc --numeric-version)" = "${ghc_ver}" ]
@@ -169,10 +169,10 @@ fi
# check that lazy loading works for 'whereis'
cp "$CI_PROJECT_DIR/data/metadata/ghcup-${JSON_VERSION}.yaml" "$CI_PROJECT_DIR/data/metadata/ghcup-${JSON_VERSION}.yaml.bak"
echo '**' > "$CI_PROJECT_DIR/data/metadata/ghcup-${JSON_VERSION}.yaml"
eghcup whereis ghc "$(ghc --numeric-version)"
eghcup whereis ghc $(ghc --numeric-version)
mv -f "$CI_PROJECT_DIR/data/metadata/ghcup-${JSON_VERSION}.yaml.bak" "$CI_PROJECT_DIR/data/metadata/ghcup-${JSON_VERSION}.yaml"
eghcup rm "$(ghc --numeric-version)"
eghcup rm $(ghc --numeric-version)
# https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/116
if [ "${OS}" = "Linux" ] ; then
@@ -186,7 +186,7 @@ eghcup gc -c
# test etags
rm -f "${GHCUP_DIR}/cache/ghcup-${JSON_VERSION}.yaml"
raw_eghcup -s "https://www.haskell.org/ghcup/data/ghcup-${JSON_VERSION}.yaml" list
raw_eghcup -s https://www.haskell.org/ghcup/data/ghcup-${JSON_VERSION}.yaml list
# snapshot yaml and etags file
etag=$(cat "${GHCUP_DIR}/cache/ghcup-${JSON_VERSION}.yaml.etags")
sha=$(sha_sum "${GHCUP_DIR}/cache/ghcup-${JSON_VERSION}.yaml")

2
.gitmodules vendored
View File

@@ -1,4 +1,4 @@
[submodule "data/metadata"]
path = data/metadata
url = https://github.com/haskell/ghcup-metadata.git
branch = develop
branch = master

View File

@@ -30,7 +30,6 @@ import Brick.Widgets.List ( listSelectedFocusedAttr
, listAttr
)
import Codec.Archive
import Control.Applicative
import Control.Exception.Safe
#if !MIN_VERSION_base(4,13,0)
import Control.Monad.Fail ( MonadFail )
@@ -46,7 +45,7 @@ import Data.IORef
import Data.Vector ( Vector
, (!?)
)
import Data.Versions
import Data.Versions hiding ( str )
import Haskus.Utils.Variant.Excepts
import Prelude hiding ( appendFile )
import System.FilePath
@@ -433,7 +432,7 @@ filterVisible v t e | lInstalled e = True
(lTool e `notElem` hiddenTools)
install' :: (MonadReader AppState m, MonadIO m, MonadThrow m, MonadFail m, MonadMask m, MonadUnliftIO m, Alternative m)
install' :: (MonadReader AppState m, MonadIO m, MonadThrow m, MonadFail m, MonadMask m, MonadUnliftIO m)
=> BrickState
-> (Int, ListResult)
-> m (Either String ())
@@ -464,11 +463,6 @@ install' _ (_, ListResult {..}) = do
, ToolShadowed
, UninstallFailed
, MergeFileTreeError
, NoCompatiblePlatform
, GHCup.Errors.ParseError
, UnsupportedSetupCombo
, DistroNotFound
, NoCompatibleArch
]
run (do
@@ -515,7 +509,7 @@ install' _ (_, ListResult {..}) = do
<> "Also check the logs in ~/.ghcup/logs"
set' :: (MonadReader AppState m, MonadIO m, MonadThrow m, MonadFail m, MonadMask m, MonadUnliftIO m, Alternative m)
set' :: (MonadReader AppState m, MonadIO m, MonadThrow m, MonadFail m, MonadMask m, MonadUnliftIO m)
=> BrickState
-> (Int, ListResult)
-> m (Either String ())

View File

@@ -88,7 +88,7 @@ data Options = Options
}
data Command
= Install (Either InstallCommand InstallGHCOptions)
= Install (Either InstallCommand InstallOptions)
| Test TestCommand
| InstallCabalLegacy InstallOptions
| Set (Either SetCommand SetOptions)

View File

@@ -48,7 +48,7 @@ import Data.Maybe
import Data.Text ( Text )
import Data.Time.Calendar ( Day )
import Data.Time.Format ( parseTimeM, defaultTimeLocale )
import Data.Versions
import Data.Versions hiding ( str )
import Data.Void
import qualified Data.Vector as V
import GHC.IO.Exception
@@ -209,7 +209,19 @@ platformParser s' = case MP.parse (platformP <* MP.eof) "" (T.pack s') of
)
]
distroP :: MP.Parsec Void Text LinuxDistro
distroP = choice' ((\d -> MP.chunk (T.pack $ distroToString d) $> d) <$> allDistros)
distroP = choice'
[ MP.chunk "debian" $> Debian
, MP.chunk "deb" $> Debian
, MP.chunk "ubuntu" $> Ubuntu
, MP.chunk "mint" $> Mint
, MP.chunk "fedora" $> Fedora
, MP.chunk "centos" $> CentOS
, MP.chunk "redhat" $> RedHat
, MP.chunk "alpine" $> Alpine
, MP.chunk "gentoo" $> Gentoo
, MP.chunk "exherbo" $> Exherbo
, MP.chunk "unknown" $> UnknownLinux
]
uriParser :: String -> Either String URI
@@ -355,7 +367,7 @@ fileUri' add = \case
-- We need to do this so bash doesn't expand out any ~ or other
-- chars we want to complete on, or emit an end of line error
-- when seeking the close to the quote.
--
--
-- NOTE: copied from https://hackage.haskell.org/package/optparse-applicative-0.17.0.0/docs/src/Options.Applicative.Builder.Completer.html#requote
requote :: String -> String
requote s =
@@ -812,7 +824,7 @@ checkForUpdates = do
logGHCPostRm :: (MonadReader env m, HasLog env, MonadIO m) => GHCTargetVersion -> m ()
logGHCPostRm ghcVer = do
cabalStore <- liftIO $ handleIO (\_ -> if isWindows then pure "C:\\cabal\\store" else pure "~/.cabal/store or ~/.local/state/cabal/store")
cabalStore <- liftIO $ handleIO (\_ -> if isWindows then pure "C:\\cabal\\store" else pure "~/.cabal/store")
(runIdentity . CC.cfgStoreDir <$> CC.readConfig)
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

View File

@@ -135,9 +135,7 @@ updateSettings usl usr =
gpgSetting' = uGPGSetting usl <|> uGPGSetting usr
platformOverride' = uPlatformOverride usl <|> uPlatformOverride usr
mirrors' = uMirrors usl <|> uMirrors usr
stackSetupSource' = uStackSetupSource usl <|> uStackSetupSource usr
stackSetup' = uStackSetup usl <|> uStackSetup usr
in UserSettings cache' metaCache' metaMode' noVerify' verbose' keepDirs' downloader' (updateKeyBindings (uKeyBindings usl) (uKeyBindings usr)) urlSource' noNetwork' gpgSetting' platformOverride' mirrors' stackSetupSource' stackSetup'
in UserSettings cache' metaCache' metaMode' noVerify' verbose' keepDirs' downloader' (updateKeyBindings (uKeyBindings usl) (uKeyBindings usr)) urlSource' noNetwork' gpgSetting' platformOverride' mirrors'
where
updateKeyBindings :: Maybe UserKeyBindings -> Maybe UserKeyBindings -> Maybe UserKeyBindings
updateKeyBindings Nothing Nothing = Nothing

View File

@@ -50,7 +50,7 @@ import qualified Data.Text as T
----------------
data InstallCommand = InstallGHC InstallGHCOptions
data InstallCommand = InstallGHC InstallOptions
| InstallCabal InstallOptions
| InstallHLS InstallOptions
| InstallStack InstallOptions
@@ -63,15 +63,6 @@ data InstallCommand = InstallGHC InstallGHCOptions
--[ Options ]--
---------------
data InstallGHCOptions = InstallGHCOptions
{ instVer :: Maybe ToolVersion
, instBindist :: Maybe URI
, instSet :: Bool
, isolateDir :: Maybe FilePath
, forceInstall :: Bool
, addConfArgs :: [T.Text]
, useStackSetup :: Maybe Bool
} deriving (Eq, Show)
data InstallOptions = InstallOptions
{ instVer :: Maybe ToolVersion
@@ -102,14 +93,14 @@ installCabalFooter = [s|Discussion:
--[ Parsers ]--
---------------
installParser :: Parser (Either InstallCommand InstallGHCOptions)
installParser :: Parser (Either InstallCommand InstallOptions)
installParser =
(Left <$> subparser
( command
"ghc"
( InstallGHC
<$> info
(installGHCOpts <**> helper)
(installOpts (Just GHC) <**> helper)
( progDesc "Install GHC"
<> footerDoc (Just $ text installGHCFooter)
)
@@ -143,7 +134,7 @@ installParser =
)
)
)
<|> (Right <$> installGHCOpts)
<|> (Right <$> installOpts Nothing)
where
installHLSFooter :: String
installHLSFooter = [s|Discussion:
@@ -219,12 +210,6 @@ installOpts tool =
Just GHC -> False
Just _ -> True
installGHCOpts :: Parser InstallGHCOptions
installGHCOpts =
(\InstallOptions{..} b -> let useStackSetup = b in InstallGHCOptions{..})
<$> installOpts (Just GHC)
<*> invertableSwitch "stack-setup" (Just 's') False (help "Set as active version after install")
@@ -306,11 +291,6 @@ type InstallGHCEffects = '[ AlreadyInstalled
, UninstallFailed
, UnknownArchive
, InstallSetError
, NoCompatiblePlatform
, GHCup.Errors.ParseError
, UnsupportedSetupCombo
, DistroNotFound
, NoCompatibleArch
]
runInstGHC :: AppState
@@ -328,21 +308,21 @@ runInstGHC appstate' =
-------------------
install :: Either InstallCommand InstallGHCOptions -> Settings -> IO AppState -> (ReaderT LeanAppState IO () -> IO ()) -> IO ExitCode
install :: Either InstallCommand InstallOptions -> Settings -> IO AppState -> (ReaderT LeanAppState IO () -> IO ()) -> IO ExitCode
install installCommand settings getAppState' runLogger = case installCommand of
(Right iGHCopts) -> do
(Right iopts) -> do
runLogger (logWarn "This is an old-style command for installing GHC. Use 'ghcup install ghc' instead.")
installGHC iGHCopts
(Left (InstallGHC iGHCopts)) -> installGHC iGHCopts
(Left (InstallCabal iopts)) -> installCabal iopts
(Left (InstallHLS iopts)) -> installHLS iopts
(Left (InstallStack iopts)) -> installStack iopts
installGHC iopts
(Left (InstallGHC iopts)) -> installGHC iopts
(Left (InstallCabal iopts)) -> installCabal iopts
(Left (InstallHLS iopts)) -> installHLS iopts
(Left (InstallStack iopts)) -> installStack iopts
where
installGHC :: InstallGHCOptions -> IO ExitCode
installGHC InstallGHCOptions{..} = do
installGHC :: InstallOptions -> IO ExitCode
installGHC InstallOptions{..} = do
s'@AppState{ dirs = Dirs{ .. } } <- liftIO getAppState'
(case instBindist of
Nothing -> runInstGHC s'{ settings = maybe settings (\b -> settings {stackSetup = b}) useStackSetup } $ do
Nothing -> runInstGHC s' $ do
(v, vi) <- liftE $ fromVersion instVer GHC
liftE $ runBothE' (installGHCBin
v

View File

@@ -27,7 +27,7 @@ import Data.List ( intercalate, sort )
import Data.Functor
import Data.Maybe
import Data.Time.Calendar ( Day )
import Data.Versions
import Data.Versions hiding ( str )
import Data.Void
import Options.Applicative hiding ( style )
import Prelude hiding ( appendFile )

View File

@@ -29,7 +29,7 @@ import Control.Monad.Reader
import Control.Monad.Trans.Resource
import Data.Functor
import Data.Maybe
import Data.Versions
import Data.Versions hiding ( str )
import Haskus.Utils.Variant.Excepts
import Options.Applicative hiding ( style )
import Prelude hiding ( appendFile )

View File

@@ -187,11 +187,6 @@ type RunEffects = '[ AlreadyInstalled
, ProcessError
, UninstallFailed
, MergeFileTreeError
, NoCompatiblePlatform
, GHCup.Errors.ParseError
, UnsupportedSetupCombo
, DistroNotFound
, NoCompatibleArch
]
runLeanRUN :: (MonadUnliftIO m, MonadIO m)
@@ -231,7 +226,6 @@ run :: forall m .
, MonadCatch m
, MonadIO m
, MonadUnliftIO m
, Alternative m
)
=> RunOptions
-> IO AppState
@@ -261,9 +255,7 @@ run RunOptions{..} runAppState leanAppstate runLogger = do
liftIO $ putStr tmp
pure ExitSuccess
(cmd:args) -> do
newEnv <- liftIO $ addToPath [tmp] runAppendPATH
let pathVar = if isWindows then "Path" else "PATH"
forM_ (Map.lookup pathVar . Map.fromList $ newEnv) $ liftIO . setEnv pathVar
newEnv <- liftIO $ addToPath tmp runAppendPATH
#ifndef IS_WINDOWS
void $ liftIO $ SPP.executeFile cmd True args (Just newEnv)
pure ExitSuccess
@@ -337,7 +329,6 @@ run RunOptions{..} runAppState leanAppstate runLogger = do
, MonadThrow m
, MonadIO m
, MonadCatch m
, Alternative m
)
=> Toolchain
-> FilePath
@@ -363,11 +354,6 @@ run RunOptions{..} runAppState leanAppstate runLogger = do
, CopyError
, UninstallFailed
, MergeFileTreeError
, NoCompatiblePlatform
, GHCup.Errors.ParseError
, UnsupportedSetupCombo
, DistroNotFound
, NoCompatibleArch
] (ResourceT (ReaderT AppState m)) ()
installToolChainFull Toolchain{..} tmp = do
case ghcVer of

View File

@@ -28,7 +28,7 @@ import Control.Monad.Trans.Resource
import Data.Either
import Data.Functor
import Data.Maybe
import Data.Versions
import Data.Versions hiding ( str )
import GHC.Unicode
import Haskus.Utils.Variant.Excepts
import Options.Applicative hiding ( style )

View File

@@ -35,7 +35,7 @@ import System.Environment
import GHCup.Utils
import System.FilePath
import GHCup.Types.Optics
import Data.Versions
import Data.Versions hiding (str)

View File

@@ -90,8 +90,6 @@ toSettings options = do
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
@@ -341,11 +339,11 @@ 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 (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
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
alreadyInstalling (Compile (CompileGHC GHCCompileOptions{ ovewrwiteVer = Just over }))
(GHC, ver) = cmp' GHC (Just $ GHCVersion (mkTVer over)) ver
alreadyInstalling (Compile (CompileGHC GHCCompileOptions{ targetGhc = GHC.SourceDist tver }))

View File

@@ -8,11 +8,6 @@ package ghcup
constraints: http-io-streams -brotli,
any.aeson >= 2.0.1.0
source-repository-package
type: git
location: https://github.com/fosskers/versions.git
tag: 7bc3355348aac3510771d4622aff09ac38c9924d
package libarchive
flags: -system-libarchive
@@ -29,4 +24,4 @@ package streamly
flags: +use-unliftio
package *
test-show-details: direct
test-show-details: direct

View File

@@ -4,11 +4,6 @@ optional-packages: ./vendored/*/*.cabal
optimization: 2
source-repository-package
type: git
location: https://github.com/fosskers/versions.git
tag: 7bc3355348aac3510771d4622aff09ac38c9924d
if os(linux)
package ghcup
flags: +tui

View File

@@ -82,18 +82,6 @@ url-source:
# - 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
# This is a way to override platform detection, e.g. when you're running
# a Ubuntu derivate based on 18.04, you could do:
#

View File

@@ -43,12 +43,6 @@ All of the following are valid arguments to `ghcup install ghc`:
If the argument is omitted, the default is `recommended`.
Other tags include:
- `prerelease`: a prerelease version
- `latest-prerelease`: the latest prerelease version
## Manpages
For man pages to work you need [man-db](http://man-db.nongnu.org/) as your `man` provider, then issue `man ghc`. Manpages only work for the currently set ghc.
@@ -209,12 +203,50 @@ url-source:
- "https://raw.githubusercontent.com/haskell/ghcup-metadata/master/ghcup-prereleases-0.0.7.yaml"
```
### Nightlies
Nightlies are just another release channel. Currently, only GHC supports nightlies, which are binary releases
that are built every night from `master`.
To add the nightly channel, run:
```sh
ghcup config add-release-channel https://ghc.gitlab.haskell.org/ghcup-metadata/ghcup-nightlies-0.0.7.yaml
```
To list all nightlies from 2023, run:
```sh
ghcup list --show-nightly --tool=ghc --since=2023-01-01
```
Ways to install a nightly:
```sh
# by date
ghcup install ghc 2023-06-20
# by version
ghcup install ghc 9.7.20230619
# by tag
ghcup install ghc latest-nightly
```
## Stack integration
Stack manages GHC versions internally by default. In order to make it use ghcup installed
GHC versions there are two strategies.
### Strategy 1: Stack hooks (new, recommended)
### Strategy 1: System GHC (works on all stack versions)
You can instruct stack to use "system" GHC versions (whatever is in PATH). To do so,
run the following commands:
```sh
stack config set install-ghc false --global
stack config set system-ghc true --global
```
### Strategy 2: Stack hooks (new, recommended)
Since stack 2.9.1 you can customize the installation logic of GHC completely, see [https://docs.haskellstack.org/en/stable/yaml_configuration/#ghc-installation-customisation](https://docs.haskellstack.org/en/stable/yaml_configuration/#ghc-installation-customisation).
@@ -236,48 +268,6 @@ stack config set system-ghc false --global
By default, when the hook fails for whatever reason, stack will fall back to its own installation logic. To disable
this, run `stack config set install-ghc false --global`.
### Strategy 2: System GHC (works on all stack versions)
You can instruct stack to use "system" GHC versions (whatever is in PATH). To do so,
run the following commands:
```sh
stack config set install-ghc false --global
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:
```sh
ghcup install ghc --stack-setup 9.4.7
```
To make this permanent, you can add the following to you `~/.ghcup/config.yaml`:
```yaml
stack-setup: true
```
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:
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
```
The main caveat with using this method is that there's no guarantee that GHCup will pick a compatible HLS bindist
when you try to install HLS.
### Windows
On windows, you may find the following config options useful too:
@@ -488,48 +478,8 @@ variables and, in the case of Windows, parameters to tweak the script behavior.
### github workflows
On github workflows GHCup itself is pre-installed on all platforms, but may use non-standard install locations.
Here's an example workflow with a GHC matrix:
```yaml
jobs:
build:
runs-on: ${{ matrix.os }}
strategy:
fail-fast: true
matrix:
os: [ubuntu-22.04, macOS-latest]
ghc: ['9.6', '9.4', '9.2', '9.0', '8.10', '8.8', '8.6']
steps:
- uses: actions/checkout@v3
- name: Setup toolchain
run: |
ghcup install cabal --set recommended
ghcup install ghc --set ${{ matrix.ghc }}
- name: Build
run: |
cabal update
cabal test all --test-show-details=direct
i386:
runs-on: ubuntu-latest
container:
image: i386/ubuntu:bionic
steps:
- name: Install GHCup in container
run: |
apt-get update -y
apt-get install -y autoconf build-essential zlib1g-dev libgmp-dev curl
# we just go with recommended versions of cabal and GHC
curl --proto '=https' --tlsv1.2 -sSf https://get-ghcup.haskell.org | BOOTSTRAP_HASKELL_NONINTERACTIVE=1 BOOTSTRAP_HASKELL_INSTALL_NO_STACK=1 sh
- uses: actions/checkout@v1
- name: Test
run: |
# in containers we need to fix PATH
source ~/.ghcup/env
cabal update
cabal test all --test-show-details=direct
```
On github workflows you can use [https://github.com/haskell/actions/](https://github.com/haskell/actions/).
GHCup itself is also pre-installed on all platforms, but may use non-standard install locations.
## GPG verification
@@ -539,10 +489,9 @@ this is cryptographically secure.
First, obtain the gpg keys:
```sh
gpg --batch --keyserver keyserver.ubuntu.com --recv-keys 7D1E8AFD1D4A16D71FADA2F2CCC85C0E40C06A8C
gpg --batch --keyserver keys.openpgp.org --recv-keys 7D1E8AFD1D4A16D71FADA2F2CCC85C0E40C06A8C
gpg --batch --keyserver keyserver.ubuntu.com --recv-keys FE5AB6C91FEA597C3B31180B73EDE9E8CFBAEF01
gpg --batch --keyserver keyserver.ubuntu.com --recv-keys 88B57FCF7DB53B4DB3BFA4B1588764FBE22D19C4
gpg --batch --keyserver keyserver.ubuntu.com --recv-keys EAF2A9A722C0C96F2B431CA511AAD8CEDEE0CAEF
```
Then verify the gpg key in one of these ways:

View File

@@ -38,85 +38,49 @@ Also see [tags and shortcuts](../guide/#tags-and-shortcuts) for more information
### Linux Debian
#### Generic
The following distro packages are required: `build-essential curl libffi-dev libffi6 libgmp-dev libgmp10 libncurses-dev libncurses5 libtinfo5`
#### Version >= 11 && <= 12
The following distro packages are required: `build-essential curl libffi-dev libffi7 libgmp-dev libgmp10 libncurses-dev libncurses5 libtinfo5`
#### Version >= 12
The following distro packages are required: `build-essential curl libffi-dev libffi8 libgmp-dev libgmp10 libncurses-dev libncurses5 libtinfo5`
### Linux Ubuntu
#### Generic
The following distro packages are required: `build-essential curl libffi-dev libffi6 libgmp-dev libgmp10 libncurses-dev libncurses5 libtinfo5`
#### Version >= 20.04 && < 20.10
The following distro packages are required: `build-essential curl libffi-dev libffi7 libgmp-dev libgmp10 libncurses-dev libncurses5 libtinfo5`
#### Version >= 20.10 && < 23
The following distro packages are required: `build-essential curl libffi-dev libffi8ubuntu1 libgmp-dev libgmp10 libncurses-dev libncurses5 libtinfo5`
#### Version >= 23
The following distro packages are required: `build-essential curl libffi-dev libffi8ubuntu1 libgmp-dev libgmp10 libncurses-dev`
### Linux Fedora
#### Generic
The following distro packages are required: `gcc gcc-c++ gmp gmp-devel make ncurses ncurses-compat-libs xz perl`
### Linux Mageia
The following distro packages are required: `curl gcc gcc-c++ gmp libffi-devel libffi7 libgmp-devel libgmp10 make libncurses-devel libncurses5 xz perl`
### Linux CentOS
#### Generic
The following distro packages are required: `gcc gcc-c++ gmp gmp-devel make ncurses ncurses-compat-libs xz perl`
#### Version >= 7 && < 8
The following distro packages are required: `gcc gcc-c++ gmp gmp-devel make ncurses xz perl`
### Linux Alpine
#### Generic
The following distro packages are required: `binutils-gold curl gcc g++ gmp-dev libc-dev libffi-dev make musl-dev ncurses-dev perl tar xz`
### Linux VoidLinux
The following distro packages are required: `gcc gmp curl coreutils xz ncurses make ncurses-libtinfo-libs perl tar`
### Linux (generic)
#### Generic
You need the following packages: curl g++ gcc gmp make ncurses realpath xz-utils. Consult your distro documentation on the exact names of those packages.
### Darwin
#### Generic
On OS X, in the course of running ghcup you will be given a dialog box to install the command line tools. Accept and the requirements will be installed for you. You will then need to run the command again.
On Darwin M1 you might also need a working llvm installed (e.g. via brew) and have the toolchain exposed in PATH.
### FreeBSD
#### Generic
The following distro packages are required: `curl gcc gmp gmake ncurses perl5 libffi libiconv`
Notice that only FreeBSD 13.x is supported. If the installation fails, complaining about `libncursesw.8.so`, you will need to install FreeBSD 12 compat package first, for example, `pkg install misc/compat12x`.
### Windows
#### Generic
On Windows, msys2 should already have been set up during the installation, so most users should just proceed. If you are installing manually, make sure to have a working mingw64 toolchain and shell.
## Next steps
@@ -207,9 +171,7 @@ GHCup supports the following tools, which are also known as the **Haskell Toolch
<table>
<thead><tr><th>HLS Version</th><th>Tags</th></tr></thead>
<tbody>
<tr><td>2.4.0.0</td><td><span style="color:blue">latest</span>, <span style="color:green">recommended</span></td></tr>
<tr><td>2.3.0.0</td><td></td></tr>
<tr><td>2.2.0.0</td><td></td></tr>
<tr><td>2.2.0.0</td><td><span style="color:blue">latest</span>, <span style="color:green">recommended</span></td></tr>
<tr><td>2.1.0.0</td><td></td></tr>
<tr><td>2.0.0.1</td><td></td></tr>
<tr><td>2.0.0.0</td><td></td></tr>
@@ -305,14 +267,7 @@ Lower availability of bindists. Stack and HLS binaries are experimental.
Download the binary for your platform at [https://downloads.haskell.org/~ghcup/](https://downloads.haskell.org/~ghcup/)
and place it into your `PATH` anywhere.
If you want to GPG verify the binaries, import the following keys first:
```sh
gpg --batch --keyserver keyserver.ubuntu.com --recv-keys 7D1E8AFD1D4A16D71FADA2F2CCC85C0E40C06A8C
gpg --batch --keyserver keyserver.ubuntu.com --recv-keys FE5AB6C91FEA597C3B31180B73EDE9E8CFBAEF01
gpg --batch --keyserver keyserver.ubuntu.com --recv-keys 88B57FCF7DB53B4DB3BFA4B1588764FBE22D19C4
gpg --batch --keyserver keyserver.ubuntu.com --recv-keys EAF2A9A722C0C96F2B431CA511AAD8CEDEE0CAEF
```
If you want to GPG verify the binaries, import the following keys first: `7D1E8AFD1D4A16D71FADA2F2CCC85C0E40C06A8C` and `FE5AB6C91FEA597C3B31180B73EDE9E8CFBAEF01`.
Then adjust your `PATH` in `~/.bashrc` (or similar, depending on your shell) like so:

View File

@@ -25,10 +25,10 @@ extra-source-files:
cbits/dirutils.h
data/build_mk/cross
data/build_mk/default
test/ghcup-test/data/dir/.keep
test/ghcup-test/data/file
test/ghcup-test/golden/unix/GHCupInfo.json
test/ghcup-test/golden/windows/GHCupInfo.json
test/data/dir/.keep
test/data/file
test/golden/unix/GHCupInfo.json
test/golden/windows/GHCupInfo.json
source-repository head
type: git
@@ -87,7 +87,7 @@ common app-common-depends
, uri-bytestring ^>=0.3.2.2
, utf8-string ^>=1.0
, vector ^>=0.12
, versions >=6.0.3 && <6.1
, versions >=4.0.1 && <5.1
, yaml-streamly ^>=0.12.0
library
@@ -117,9 +117,7 @@ library
GHCup.Types
GHCup.Types.JSON
GHCup.Types.JSON.Utils
GHCup.Types.JSON.Versions
GHCup.Types.Optics
GHCup.Types.Stack
GHCup.Utils
GHCup.Utils.Dirs
GHCup.Version
@@ -191,7 +189,7 @@ library
, unordered-containers ^>=0.2.10.0
, uri-bytestring ^>=0.3.2.2
, vector ^>=0.12
, versions >=6.0.3 && <6.1
, versions >=4.0.1 && <5.1
, word8 ^>=0.1.3
, yaml-streamly ^>=0.12.0
, zlib ^>=0.6.2.2
@@ -238,7 +236,7 @@ library
if (flag(tui) && !os(windows))
cpp-options: -DBRICK
build-depends: vty ^>=5.39
build-depends: vty ^>=5.37
library ghcup-optparse
import: app-common-depends
@@ -263,7 +261,7 @@ library ghcup-optparse
GHCup.OptParse.Upgrade
GHCup.OptParse.Whereis
hs-source-dirs: lib-opt
hs-source-dirs: app/ghcup
default-language: Haskell2010
default-extensions:
LambdaCase
@@ -286,6 +284,12 @@ library ghcup-optparse
if (flag(tui) && !os(windows))
cpp-options: -DBRICK
other-modules: BrickMain
build-depends:
, brick ^>=1.5
, transformers ^>=0.5
, unix ^>=2.7
, vty ^>=5.37
if os(windows)
cpp-options: -DIS_WINDOWS
@@ -296,6 +300,26 @@ library ghcup-optparse
executable ghcup
import: app-common-depends
main-is: Main.hs
other-modules:
GHCup.OptParse
GHCup.OptParse.ChangeLog
GHCup.OptParse.Common
GHCup.OptParse.Compile
GHCup.OptParse.Config
GHCup.OptParse.DInfo
GHCup.OptParse.GC
GHCup.OptParse.Install
GHCup.OptParse.List
GHCup.OptParse.Nuke
GHCup.OptParse.Prefetch
GHCup.OptParse.Rm
GHCup.OptParse.Run
GHCup.OptParse.Set
GHCup.OptParse.Test
GHCup.OptParse.ToolRequirements
GHCup.OptParse.UnSet
GHCup.OptParse.Upgrade
GHCup.OptParse.Whereis
hs-source-dirs: app/ghcup
default-language: Haskell2010
@@ -327,7 +351,7 @@ executable ghcup
, brick ^>=1.5
, transformers ^>=0.5
, unix ^>=2.7
, vty ^>=5.39
, vty ^>=5.37
if os(windows)
cpp-options: -DIS_WINDOWS
@@ -379,7 +403,7 @@ test-suite ghcup-test
, text ^>=2.0
, time >=1.9.3 && <1.12
, uri-bytestring ^>=0.3.2.2
, versions >=6.0.3 && <6.1
, versions >=4.0.1 && <5.1
if os(windows)
cpp-options: -DIS_WINDOWS
@@ -419,7 +443,6 @@ test-suite ghcup-optparse-test
, optparse-applicative
, tasty
, tasty-hunit
, template-haskell
, text
, uri-bytestring
, versions

View File

@@ -5,6 +5,7 @@
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-|
Module : GHCup.Download
Description : Downloading
@@ -30,8 +31,6 @@ import GHCup.Download.Utils
#endif
import GHCup.Errors
import GHCup.Types
import qualified GHCup.Types.Stack as Stack
import GHCup.Types.Stack (downloadInfoUrl, downloadInfoSha256)
import GHCup.Types.Optics
import GHCup.Types.JSON ( )
import GHCup.Utils.Dirs
@@ -160,10 +159,9 @@ getBase :: ( MonadReader env m
, MonadCatch m
, HasLog env
, MonadMask m
, FromJSON j
)
=> URI
-> Excepts '[DownloadFailed, GPGError, DigestError, ContentLengthError, JSONError, FileDoesNotExistError] m j
-> Excepts '[DownloadFailed, GPGError, DigestError, ContentLengthError, JSONError, FileDoesNotExistError] m GHCupInfo
getBase uri = do
Settings { noNetwork, downloader, metaMode } <- lift getSettings
@@ -327,107 +325,6 @@ getDownloadInfo' t v = do
_ -> with_distro <|> without_distro_ver <|> without_distro
)
getStackDownloadInfo :: ( MonadReader env m
, HasDirs env
, HasGHCupInfo env
, HasLog env
, HasPlatformReq env
, HasSettings env
, MonadCatch m
, MonadFail m
, MonadIO m
, MonadMask m
, MonadThrow m
)
=> StackSetupURLSource
-> [String]
-> Tool
-> GHCTargetVersion
-- ^ tool version
-> Excepts
'[NoDownload, DownloadFailed]
m
DownloadInfo
getStackDownloadInfo stackSetupSource keys@(_:_) GHC tv@(GHCTargetVersion Nothing v) =
case stackSetupSource of
StackSetupURL -> do
(dli :: Stack.SetupInfo) <- liftE $ reThrowAll @_ @_ @'[DownloadFailed] DownloadFailed $ getBase stackSetupURL
sDli <- liftE $ stackDownloadInfo dli
lift $ fromStackDownloadInfo sDli
(SOwnSource exts) -> do
(dlis :: [Stack.SetupInfo]) <- liftE $ reThrowAll @_ @_ @'[DownloadFailed] DownloadFailed $ mapM (either pure getBase) exts
dli <- lift $ mergeSetupInfo dlis
sDli <- liftE $ stackDownloadInfo dli
lift $ fromStackDownloadInfo sDli
(SOwnSpec si) -> do
sDli <- liftE $ stackDownloadInfo si
lift $ fromStackDownloadInfo sDli
(SAddSource exts) -> do
base :: Stack.SetupInfo <- liftE $ reThrowAll @_ @_ @'[DownloadFailed] DownloadFailed $ getBase stackSetupURL
(dlis :: [Stack.SetupInfo]) <- liftE $ reThrowAll @_ @_ @'[DownloadFailed] DownloadFailed $ mapM (either pure getBase) exts
dli <- lift $ mergeSetupInfo (base:dlis)
sDli <- liftE $ stackDownloadInfo dli
lift $ fromStackDownloadInfo sDli
where
stackDownloadInfo :: MonadIO m => Stack.SetupInfo -> Excepts '[NoDownload] m Stack.DownloadInfo
stackDownloadInfo dli@Stack.SetupInfo{} = do
let siGHCs = Stack.siGHCs dli
ghcVersionsPerKey = (`M.lookup` siGHCs) <$> (T.pack <$> keys)
ghcVersions <- (listToMaybe . catMaybes $ ghcVersionsPerKey) ?? NoDownload tv GHC Nothing
(Stack.gdiDownloadInfo <$> M.lookup v ghcVersions) ?? NoDownload tv GHC Nothing
mergeSetupInfo :: MonadFail m
=> [Stack.SetupInfo]
-> m Stack.SetupInfo
mergeSetupInfo [] = fail "mergeSetupInfo: internal error: need at least one SetupInfo"
mergeSetupInfo xs@(Stack.SetupInfo{}: _) =
let newSevenzExe = Stack.siSevenzExe $ last xs
newSevenzDll = Stack.siSevenzDll $ last xs
newMsys2 = M.unionsWith (\_ a2 -> a2 ) (Stack.siMsys2 <$> xs)
newGHCs = M.unionsWith (M.unionWith (\_ b2 -> b2)) (Stack.siGHCs <$> xs)
newStack = M.unionsWith (M.unionWith (\_ b2 -> b2)) (Stack.siStack <$> xs)
in pure $ Stack.SetupInfo newSevenzExe newSevenzDll newMsys2 newGHCs newStack
fromStackDownloadInfo :: MonadThrow m => Stack.DownloadInfo -> m DownloadInfo
fromStackDownloadInfo Stack.DownloadInfo{..} = do
url <- either (\e -> throwM $ ParseError (show e)) pure $ parseURI strictURIParserOptions . E.encodeUtf8 $ downloadInfoUrl
sha256 <- maybe (throwM $ DigestMissing url) (pure . E.decodeUtf8) downloadInfoSha256
pure $ DownloadInfo url (Just $ RegexDir "ghc-.*") sha256 Nothing Nothing
getStackDownloadInfo _ _ t v = throwE $ NoDownload v t Nothing
{--
data SetupInfo = SetupInfo
{ siSevenzExe :: Maybe DownloadInfo
, siSevenzDll :: Maybe DownloadInfo
, siMsys2 :: Map Text VersionedDownloadInfo
, siGHCs :: Map Text (Map Version GHCDownloadInfo)
, siStack :: Map Text (Map Version DownloadInfo)
data VersionedDownloadInfo = VersionedDownloadInfo
{ vdiVersion :: Version
, vdiDownloadInfo :: DownloadInfo
}
}
data DownloadInfo = DownloadInfo
{ downloadInfoUrl :: Text
-- ^ URL or absolute file path
, downloadInfoContentLength :: Maybe Int
, downloadInfoSha1 :: Maybe ByteString
, downloadInfoSha256 :: Maybe ByteString
}
data GHCDownloadInfo = GHCDownloadInfo
{ gdiConfigureOpts :: [Text]
, gdiConfigureEnv :: Map Text Text
, gdiDownloadInfo :: DownloadInfo
}
--}
-- | Tries to download from the given http or https url
-- and saves the result in continuous memory into a file.

View File

@@ -87,7 +87,6 @@ allHFError = unlines allErrors
, let proxy = Proxy :: Proxy ToolShadowed in format proxy
, let proxy = Proxy :: Proxy ContentLengthError in format proxy
, let proxy = Proxy :: Proxy DuplicateReleaseChannel in format proxy
, let proxy = Proxy :: Proxy UnsupportedSetupCombo in format proxy
, ""
, "# high level errors (4000+)"
, let proxy = Proxy :: Proxy DownloadFailed in format proxy
@@ -100,7 +99,6 @@ allHFError = unlines allErrors
, let proxy = Proxy :: Proxy ParseError in format proxy
, let proxy = Proxy :: Proxy UnexpectedListLength in format proxy
, let proxy = Proxy :: Proxy NoUrlBase in format proxy
, let proxy = Proxy :: Proxy DigestMissing in format proxy
, ""
, "# orphans (800+)"
, let proxy = Proxy :: Proxy URIParseError in format proxy
@@ -689,17 +687,6 @@ instance Pretty DuplicateReleaseChannel where
<> (T.unpack . E.decodeUtf8With E.lenientDecode . serializeURIRef') uri
<> "\nGiving up. You can use '--force' to remove and append the duplicate URI (this may change order/semantics)."
data UnsupportedSetupCombo = UnsupportedSetupCombo Architecture Platform
deriving Show
instance Pretty UnsupportedSetupCombo where
pPrint (UnsupportedSetupCombo arch plat) =
text "Could not find a compatible setup combo for:" <+> pPrint arch <+> pPrint plat
instance HFErrorProject UnsupportedSetupCombo where
eBase _ = 360
eDesc _ = "Could not find a compatible setup combo"
-------------------------
--[ High-level errors ]--
-------------------------
@@ -834,18 +821,6 @@ instance HFErrorProject NoUrlBase where
eBase _ = 520
eDesc _ = "URL does not have a base filename."
data DigestMissing = DigestMissing URI
deriving Show
instance Pretty DigestMissing where
pPrint (DigestMissing uri) =
text "Digest missing for:" <+> (text . T.unpack . E.decodeUtf8With E.lenientDecode . serializeURIRef') uri
instance Exception DigestMissing
instance HFErrorProject DigestMissing where
eBase _ = 530
eDesc _ = "An expected digest is missing."
------------------------

View File

@@ -26,7 +26,6 @@ import GHCup.Types
import GHCup.Types.JSON ( )
import GHCup.Types.Optics
import GHCup.Utils
import GHCup.Platform
import GHCup.Prelude
import GHCup.Prelude.File
import GHCup.Prelude.Logger
@@ -75,7 +74,6 @@ import qualified Crypto.Hash.SHA256 as SHA256
import qualified Data.ByteString.Base16 as B16
import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as BL
import qualified Data.Map.Strict as Map
import qualified Data.Text as T
import qualified Data.Text.IO as T
import qualified Data.Text.Encoding as E
@@ -218,9 +216,7 @@ testUnpackedGHC path tver addMakeArgs = do
lift $ logInfo $ "Testing GHC version " <> tVerToText tver <> "!"
ghcDir <- lift $ ghcupGHCDir tver
let ghcBinDir = fromGHCupPath ghcDir </> "bin"
env <- liftIO $ addToPath [ghcBinDir] False
let pathVar = if isWindows then "Path" else "PATH"
forM_ (Map.lookup pathVar . Map.fromList $ env) $ liftIO . setEnv pathVar
env <- liftIO $ addToPath ghcBinDir False
lEM $ make' (fmap T.unpack addMakeArgs)
(Just $ fromGHCupPath path)
@@ -516,7 +512,6 @@ installGHCBin :: ( MonadFail m
, MonadResource m
, MonadIO m
, MonadUnliftIO m
, Alternative m
)
=> GHCTargetVersion -- ^ the version to install
-> InstallDir
@@ -538,23 +533,11 @@ installGHCBin :: ( MonadFail m
, ProcessError
, UninstallFailed
, MergeFileTreeError
, NoCompatiblePlatform
, ParseError
, UnsupportedSetupCombo
, DistroNotFound
, NoCompatibleArch
]
m
()
installGHCBin tver installDir forceInstall addConfArgs = do
Settings{ stackSetupSource, stackSetup } <- lift getSettings
dlinfo <- if stackSetup
then do
lift $ logInfo "Using stack's setup-info to install GHC"
pfreq <- lift getPlatformReq
keys <- liftE $ getStackPlatformKey pfreq
liftE $ getStackDownloadInfo stackSetupSource keys GHC tver
else liftE $ getDownloadInfo' GHC tver
dlinfo <- liftE $ getDownloadInfo' GHC tver
liftE $ installGHCBindist dlinfo tver installDir forceInstall addConfArgs

View File

@@ -717,10 +717,8 @@ getCabalVersion fp = do
gpd <- case parseGenericPackageDescriptionMaybe contents of
Nothing -> fail $ "could not parse cabal file: " <> fp
Just r -> pure r
let tver = (\c -> Version Nothing c Nothing Nothing)
. Chunks
. NE.fromList
. fmap (Numeric . fromIntegral)
let tver = (\c -> Version Nothing c [] Nothing)
. NE.fromList . fmap (NE.fromList . (:[]) . digits . fromIntegral)
. versionNumbers
. pkgVersion
. package

View File

@@ -23,13 +23,11 @@ import GHCup.Errors
import GHCup.Types
import GHCup.Types.Optics
import GHCup.Types.JSON ( )
import GHCup.Utils
import GHCup.Utils.Dirs
import GHCup.Prelude
import GHCup.Prelude.Logger
import GHCup.Prelude.Process
import GHCup.Prelude.String.QQ
import GHCup.Prelude.Version.QQ
import GHCup.Prelude.MegaParsec
#if !MIN_VERSION_base(4,13,0)
import Control.Monad.Fail ( MonadFail )
@@ -50,18 +48,11 @@ import Prelude hiding ( abs
)
import System.Info
import System.OsRelease
import System.Exit
import System.FilePath
import Text.PrettyPrint.HughesPJClass ( prettyShow )
import Text.Regex.Posix
import qualified Text.Megaparsec as MP
import qualified Data.Text as T
import qualified Data.Text.IO as T
import Data.Void
import qualified Data.List as L
@@ -206,155 +197,3 @@ getLinuxDistro = do
try_debian_version = do
ver <- T.readFile debian_version
pure (T.pack "debian", Just ver)
getStackGhcBuilds :: (MonadReader env m, HasLog env, MonadIO m)
=> PlatformResult
-> Excepts '[ParseError, NoCompatiblePlatform, DistroNotFound, ProcessError] m [String]
getStackGhcBuilds PlatformResult{..} = do
case _platform of
Linux _ -> do
-- Some systems don't have ldconfig in the PATH, so make sure to look in
-- /sbin and /usr/sbin as well
sbinEnv <- liftIO $ addToPath sbinDirs False
ldConfig <- lift $ executeOut' "ldconfig" ["-p"] Nothing (Just sbinEnv)
firstWords <- case ldConfig of
CapturedProcess ExitSuccess so _ ->
pure . mapMaybe (listToMaybe . T.words) . T.lines . T.pack . stripNewlineEnd . T.unpack . decUTF8Safe' $ so
CapturedProcess (ExitFailure _) _ _ ->
-- throwE $ NonZeroExit c "ldconfig" ["-p" ]
pure []
let checkLib :: (MonadReader env m, HasLog env, MonadIO m) => String -> m Bool
checkLib lib
| libT `elem` firstWords = do
logDebug $ "Found shared library " <> libT <> " in 'ldconfig -p' output"
pure True
| isWindows =
-- Cannot parse /usr/lib on Windows
pure False
| otherwise = hasMatches lib usrLibDirs
-- This is a workaround for the fact that libtinfo.so.x doesn't
-- appear in the 'ldconfig -p' output on Arch or Slackware even
-- when it exists. There doesn't seem to be an easy way to get the
-- true list of directories to scan for shared libs, but this
-- works for our particular cases.
where
libT = T.pack lib
hasMatches :: (MonadReader env m, HasLog env, MonadIO m) => String -> [FilePath] -> m Bool
hasMatches lib dirs = do
matches <- filterM (liftIO . doesFileExist . (</> lib)) dirs
case matches of
[] -> logDebug ("Did not find shared library " <> libT) >> pure False
(path:_) -> logDebug ("Found shared library " <> libT <> " in " <> T.pack path) >> pure True
where
libT = T.pack lib
getLibc6Version :: MonadIO m
=> Excepts '[ParseError, ProcessError] m Version
getLibc6Version = do
CapturedProcess{..} <- lift $ executeOut "ldd" ["--version"] Nothing
case _exitCode of
ExitSuccess -> either (throwE . ParseError . show) pure
. MP.parse lddVersion "" . T.pack . stripNewlineEnd . T.unpack . decUTF8Safe' $ _stdOut
ExitFailure c -> throwE $ NonZeroExit c "ldd" ["--version" ]
-- Assumes the first line of ldd has the format:
--
-- ldd (...) nn.nn
--
-- where nn.nn corresponds to the version of libc6.
lddVersion :: MP.Parsec Void Text Version
lddVersion = do
skipWhile (/= ')')
skip (== ')')
skipSpace
version'
hasMusl <- hasMatches relFileLibcMuslx86_64So1 libDirs
mLibc6Version <- veitherToEither <$> runE getLibc6Version
case mLibc6Version of
Right libc6Version -> logDebug $ "Found shared library libc6 in version: " <> prettyVer libc6Version
Left _ -> logDebug "Did not find a version of shared library libc6."
let hasLibc6_2_32 = either (const False) (>= [vver|2.32|]) mLibc6Version
hastinfo5 <- checkLib relFileLibtinfoSo5
hastinfo6 <- checkLib relFileLibtinfoSo6
hasncurses6 <- checkLib relFileLibncurseswSo6
hasgmp5 <- checkLib relFileLibgmpSo10
hasgmp4 <- checkLib relFileLibgmpSo3
let libComponents = if hasMusl
then
[ ["musl"] ]
else
concat
[ if hastinfo6 && hasgmp5
then
if hasLibc6_2_32
then [["tinfo6"]]
else [["tinfo6-libc6-pre232"]]
else [[]]
, [ [] | hastinfo5 && hasgmp5 ]
, [ ["ncurses6"] | hasncurses6 && hasgmp5 ]
, [ ["gmp4"] | hasgmp4 ]
]
pure $ map
(\c -> case c of
[] -> []
_ -> L.intercalate "-" c)
libComponents
FreeBSD ->
case _distroVersion of
Just fVer
| fVer >= [vers|12|] -> pure []
_ -> pure ["ino64"]
Darwin -> pure []
Windows -> pure []
where
relFileLibcMuslx86_64So1 :: FilePath
relFileLibcMuslx86_64So1 = "libc.musl-x86_64.so.1"
libDirs :: [FilePath]
libDirs = ["/lib", "/lib64"]
usrLibDirs :: [FilePath]
usrLibDirs = ["/usr/lib", "/usr/lib64"]
sbinDirs :: [FilePath]
sbinDirs = ["/sbin", "/usr/sbin"]
relFileLibtinfoSo5 :: FilePath
relFileLibtinfoSo5 = "libtinfo.so.5"
relFileLibtinfoSo6 :: FilePath
relFileLibtinfoSo6 = "libtinfo.so.6"
relFileLibncurseswSo6 :: FilePath
relFileLibncurseswSo6 = "libncursesw.so.6"
relFileLibgmpSo10 :: FilePath
relFileLibgmpSo10 = "libgmp.so.10"
relFileLibgmpSo3 :: FilePath
relFileLibgmpSo3 = "libgmp.so.3"
getStackOSKey :: Monad m => PlatformRequest -> Excepts '[UnsupportedSetupCombo] m String
getStackOSKey PlatformRequest { .. } =
case (_rArch, _rPlatform) of
(A_32 , Linux _) -> pure "linux32"
(A_64 , Linux _) -> pure "linux64"
(A_32 , Darwin ) -> pure "macosx"
(A_64 , Darwin ) -> pure "macosx"
(A_32 , FreeBSD) -> pure "freebsd32"
(A_64 , FreeBSD) -> pure "freebsd64"
(A_32 , Windows) -> pure "windows32"
(A_64 , Windows) -> pure "windows64"
(A_ARM , Linux _) -> pure "linux-armv7"
(A_ARM64, Linux _) -> pure "linux-aarch64"
(A_Sparc, Linux _) -> pure "linux-sparc"
(A_ARM64, Darwin ) -> pure "macosx-aarch64"
(A_ARM64, FreeBSD) -> pure "freebsd-aarch64"
(arch', os') -> throwE $ UnsupportedSetupCombo arch' os'
getStackPlatformKey :: (MonadReader env m, Alternative m, MonadFail m, HasLog env, MonadCatch m, MonadIO m)
=> PlatformRequest
-> Excepts '[UnsupportedSetupCombo, ParseError, NoCompatiblePlatform, NoCompatibleArch, DistroNotFound, ProcessError] m [String]
getStackPlatformKey pfreq@PlatformRequest{..} = do
osKey <- liftE $ getStackOSKey pfreq
builds <- liftE $ getStackGhcBuilds (PlatformResult _rPlatform _rVersion)
let builds' = (\build -> if null build then osKey else osKey <> "-" <> build) <$> builds
logDebug $ "Potential GHC builds: " <> mconcat (L.intersperse ", " $ fmap T.pack builds')
pure builds'

View File

@@ -91,16 +91,18 @@ ghcTargetVerP =
verP' :: MP.Parsec Void Text Text
verP' = do
v <- version'
let startsWithDigits =
let startsWithDigists =
and
. take 3
. map (\case
Numeric _ -> True
Alphanum _ -> False)
. concatMap
(map
(\case
(Digits _) -> True
(Str _) -> False
) . NE.toList)
. NE.toList
. (\(Chunks nec) -> nec)
$ _vChunks v
if startsWithDigits && isNothing (_vEpoch v)
if startsWithDigists && isNothing (_vEpoch v)
then pure $ prettyVer v
else fail "Oh"
@@ -120,17 +122,3 @@ verP suffix = do
pathSep :: MP.Parsec Void Text Char
pathSep = MP.oneOf pathSeparators
skipWhile :: (Char -> Bool) -> MP.Parsec Void Text ()
skipWhile f = void $ MP.takeWhileP Nothing f
skip :: (Char -> Bool) -> MP.Parsec Void Text ()
skip f = void $ MP.satisfy f
skipSpace :: MP.Parsec Void Text ()
skipSpace = void $ MP.satisfy isSpace
isSpace :: Char -> Bool
isSpace c = (c == ' ') || ('\t' <= c && c <= '\r')
{-# INLINE isSpace #-}

View File

@@ -11,7 +11,6 @@ Portability : portable
-}
module GHCup.Prelude.Process (
executeOut,
executeOut',
execLogged,
exec,
toProcessError,

View File

@@ -70,16 +70,6 @@ executeOut path args chdir = liftIO $ captureOutStreams $ do
maybe (pure ()) changeWorkingDirectory chdir
SPP.executeFile path True args Nothing
executeOut' :: MonadIO m
=> FilePath -- ^ command as filename, e.g. 'ls'
-> [String] -- ^ arguments to the command
-> Maybe FilePath -- ^ chdir to this path
-> Maybe [(String, String)]
-> m CapturedProcess
executeOut' path args chdir env = liftIO $ captureOutStreams $ do
maybe (pure ()) changeWorkingDirectory chdir
SPP.executeFile path True args env
execLogged :: ( MonadReader env m
, HasSettings env
@@ -179,7 +169,7 @@ execLogged exe args chdir lfile env = do
overwriteNthLine n str = pos1 <> moveLineUp n <> clearLine <> str <> moveLineDown n <> pos1
blue :: ByteString -> ByteString
blue bs
blue bs
| no_color = bs
| otherwise = "\x1b[0;34m" <> bs <> "\x1b[0m"

View File

@@ -140,16 +140,8 @@ executeOut :: MonadIO m
-> [String] -- ^ arguments to the command
-> Maybe FilePath -- ^ chdir to this path
-> m CapturedProcess
executeOut path args chdir = executeOut' path args chdir Nothing
executeOut' :: MonadIO m
=> FilePath -- ^ command as filename, e.g. 'ls'
-> [String] -- ^ arguments to the command
-> Maybe FilePath -- ^ chdir to this path
-> Maybe [(String, String)]
-> m CapturedProcess
executeOut' path args chdir env' = do
cp <- createProcessWithMingwPath ((proc path args){ cwd = chdir, env = env' })
executeOut path args chdir = do
cp <- createProcessWithMingwPath ((proc path args){ cwd = chdir })
(exit, out, err) <- liftIO $ readCreateProcessWithExitCodeBS cp ""
pure $ CapturedProcess exit out err

View File

@@ -26,14 +26,36 @@ import GHC.Base
#endif
import Language.Haskell.TH
import Language.Haskell.TH.Quote ( QuasiQuoter(..) )
import Language.Haskell.TH.Syntax ( dataToExpQ )
import Language.Haskell.TH.Syntax ( Lift
, dataToExpQ
)
import qualified Data.Text as T
import qualified Language.Haskell.TH.Syntax as TH
deriving instance Data Versioning
deriving instance Lift Versioning
deriving instance Data Version
deriving instance Lift Version
deriving instance Data SemVer
deriving instance Lift SemVer
deriving instance Data Mess
deriving instance Lift Mess
deriving instance Data MChunk
deriving instance Lift MChunk
deriving instance Data PVP
deriving instance Lift PVP
deriving instance Lift VSep
deriving instance Data VSep
deriving instance Lift VUnit
deriving instance Data VUnit
#if !MIN_VERSION_base(4,13,0)
deriving instance Lift (NonEmpty Word)
deriving instance Lift (NonEmpty VChunk)
deriving instance Lift (NonEmpty MChunk)
deriving instance Lift (NonEmpty VUnit)
#endif
qq :: (Text -> Q Exp) -> QuasiQuoter

View File

@@ -26,7 +26,6 @@ module GHCup.Types
)
where
import GHCup.Types.Stack ( SetupInfo )
import {-# SOURCE #-} GHCup.Utils.Dirs ( fromGHCupPath, GHCupPath )
import Control.DeepSeq ( NFData, rnf )
@@ -47,6 +46,7 @@ import qualified Data.ByteString.Lazy as BL
import qualified Data.Text as T
import qualified GHC.Generics as GHC
import qualified Data.List.NonEmpty as NE
import Data.Foldable (foldMap)
#if !defined(BRICK)
data Key = KEsc | KChar Char | KBS | KEnter
@@ -58,7 +58,6 @@ data Key = KEsc | KChar Char | KBS | KEnter
#endif
--------------------
--[ GHCInfo Tree ]--
--------------------
@@ -158,17 +157,13 @@ instance NFData VersionInfo
-- | A tag. These are currently attached to a version of a tool.
data Tag = Latest -- ^ the latest version of a tool (unique per tool)
| Recommended -- ^ the recommended version of a tool (unique per tool)
| Prerelease -- ^ denotes a prerelease version
-- (a version should either be 'Prerelease' or
-- 'LatestPrerelease', but not both)
| LatestPrerelease -- ^ the latest prerelease (unique per tool)
| Nightly -- ^ denotes a nightly version
-- (a version should either be 'Nightly' or
-- 'LatestNightly', but not both)
| LatestNightly -- ^ the latest nightly (unique per tool)
| Base PVP -- ^ the base version shipped with GHC
data Tag = Latest
| Recommended
| Prerelease
| LatestPrerelease
| Nightly
| LatestNightly
| Base PVP
| Old -- ^ old versions are hidden by default in TUI
| UnknownTag String -- ^ used for upwardscompat
deriving (Ord, Eq, GHC.Generic, Show) -- FIXME: manual JSON instance
@@ -250,18 +245,13 @@ data LinuxDistro = Debian
| RedHat
| Alpine
| AmazonLinux
| Rocky
| Void
-- rolling
| Gentoo
| Exherbo
-- not known
| UnknownLinux
-- ^ must exit
deriving (Eq, GHC.Generic, Ord, Show, Enum, Bounded)
allDistros :: [LinuxDistro]
allDistros = enumFromTo minBound maxBound
deriving (Eq, GHC.Generic, Ord, Show)
instance NFData LinuxDistro
@@ -274,8 +264,6 @@ distroToString CentOS = "centos"
distroToString RedHat = "redhat"
distroToString Alpine = "alpine"
distroToString AmazonLinux = "amazon"
distroToString Rocky = "rocky"
distroToString Void = "void"
distroToString Gentoo = "gentoo"
distroToString Exherbo = "exherbo"
distroToString UnknownLinux = "unknown"
@@ -340,19 +328,10 @@ data URLSource = GHCupURL
| AddSource [Either GHCupInfo URI] -- ^ merge with GHCupURL
deriving (GHC.Generic, Show)
data StackSetupURLSource = StackSetupURL
| SOwnSource [Either SetupInfo URI] -- ^ complete source list
| SOwnSpec SetupInfo
| SAddSource [Either SetupInfo URI] -- ^ merge with GHCupURL
deriving (Show, Eq, GHC.Generic)
instance NFData StackSetupURLSource
instance NFData URLSource
instance NFData (URIRef Absolute) where
rnf (URI !_ !_ !_ !_ !_) = ()
data MetaMode = Strict
| Lax
deriving (Show, Read, Eq, GHC.Generic)
@@ -373,13 +352,11 @@ data UserSettings = UserSettings
, uGPGSetting :: Maybe GPGSetting
, uPlatformOverride :: Maybe PlatformRequest
, uMirrors :: Maybe DownloadMirrors
, uStackSetupSource :: Maybe StackSetupURLSource
, uStackSetup :: Maybe Bool
}
deriving (Show, GHC.Generic)
defaultUserSettings :: UserSettings
defaultUserSettings = UserSettings Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing
defaultUserSettings = UserSettings Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing
fromSettings :: Settings -> Maybe KeyBindings -> UserSettings
fromSettings Settings{..} Nothing =
@@ -397,8 +374,6 @@ fromSettings Settings{..} Nothing =
, uGPGSetting = Just gpgSetting
, uPlatformOverride = platformOverride
, uMirrors = Just mirrors
, uStackSetupSource = Just stackSetupSource
, uStackSetup = Just stackSetup
}
fromSettings Settings{..} (Just KeyBindings{..}) =
let ukb = UserKeyBindings
@@ -426,8 +401,6 @@ fromSettings Settings{..} (Just KeyBindings{..}) =
, uGPGSetting = Just gpgSetting
, uPlatformOverride = platformOverride
, uMirrors = Just mirrors
, uStackSetupSource = Just stackSetupSource
, uStackSetup = Just stackSetup
}
data UserKeyBindings = UserKeyBindings
@@ -512,8 +485,6 @@ data Settings = Settings
, noColor :: Bool -- this also exists in LoggerConfig
, platformOverride :: Maybe PlatformRequest
, mirrors :: DownloadMirrors
, stackSetupSource :: StackSetupURLSource
, stackSetup :: Bool
}
deriving (Show, GHC.Generic)
@@ -521,7 +492,7 @@ defaultMetaCache :: Integer
defaultMetaCache = 300 -- 5 minutes
defaultSettings :: Settings
defaultSettings = Settings False defaultMetaCache Lax False Never Curl False GHCupURL False GPGNone False Nothing (DM mempty) StackSetupURL False
defaultSettings = Settings False defaultMetaCache Lax False Never Curl False GHCupURL False GPGNone False Nothing (DM mempty)
instance NFData Settings
@@ -767,4 +738,3 @@ instance Pretty ToolVersion where
data BuildSystem = Hadrian
| Make
deriving (Show, Eq)

View File

@@ -23,7 +23,6 @@ module GHCup.Types.JSON where
import GHCup.Types
import GHCup.Types.JSON.Utils
import GHCup.Types.JSON.Versions ()
import GHCup.Prelude.MegaParsec
import Control.Applicative ( (<|>) )
@@ -49,11 +48,10 @@ deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''MetaMo
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''Architecture
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''LinuxDistro
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''VSep
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''VUnit
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''MChunk
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''Platform
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''Mess
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''Chunk
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''Release
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''SemVer
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''Tool
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''GlobalTool
@@ -113,6 +111,34 @@ instance FromJSONKey GHCTargetVersion where
Right x -> pure x
Left e -> fail $ "Failure in GHCTargetVersion (FromJSONKey)" <> show e
instance ToJSON Versioning where
toJSON = toJSON . prettyV
instance FromJSON Versioning where
parseJSON = withText "Versioning" $ \t -> case versioning t of
Right x -> pure x
Left e -> fail $ "Failure in GHCTargetVersion (FromJSON)" <> show e
instance ToJSONKey Versioning where
toJSONKey = toJSONKeyText $ \x -> prettyV x
instance FromJSONKey Versioning where
fromJSONKey = FromJSONKeyTextParser $ \t -> case versioning t of
Right x -> pure x
Left e -> fail $ "Failure in Versioning (FromJSONKey)" <> show e
instance ToJSONKey (Maybe Versioning) where
toJSONKey = toJSONKeyText $ \case
Just x -> prettyV x
Nothing -> T.pack "unknown_versioning"
instance FromJSONKey (Maybe Versioning) where
fromJSONKey = FromJSONKeyTextParser $ \t ->
if t == T.pack "unknown_versioning" then pure Nothing else just t
where
just t = case versioning t of
Right x -> pure $ Just x
Left e -> fail $ "Failure in (Maybe Versioning) (FromJSONKey)" <> show e
instance ToJSONKey Platform where
toJSONKey = toJSONKeyText $ \case
@@ -149,6 +175,43 @@ instance ToJSONKey Architecture where
instance FromJSONKey Architecture where
fromJSONKey = genericFromJSONKey defaultJSONKeyOptions
instance ToJSONKey (Maybe Version) where
toJSONKey = toJSONKeyText $ \case
Just x -> prettyVer x
Nothing -> T.pack "unknown_version"
instance FromJSONKey (Maybe Version) where
fromJSONKey = FromJSONKeyTextParser $ \t ->
if t == T.pack "unknown_version" then pure Nothing else just t
where
just t = case version t of
Right x -> pure $ Just x
Left e -> fail $ "Failure in (Maybe Version) (FromJSONKey)" <> show e
instance ToJSON Version where
toJSON = toJSON . prettyVer
instance FromJSON Version where
parseJSON = withText "Version" $ \t -> case version t of
Right x -> pure x
Left e -> fail $ "Failure in Version (FromJSON)" <> show e
instance ToJSONKey Version where
toJSONKey = toJSONKeyText $ \x -> prettyVer x
instance FromJSONKey Version where
fromJSONKey = FromJSONKeyTextParser $ \t -> case version t of
Right x -> pure x
Left e -> fail $ "Failure in Version (FromJSONKey)" <> show e
instance ToJSON PVP where
toJSON = toJSON . prettyPVP
instance FromJSON PVP where
parseJSON = withText "PVP" $ \t -> case pvp t of
Right x -> pure x
Left e -> fail $ "Failure in PVP (FromJSON)" <> show e
instance ToJSONKey Tool where
toJSONKey = genericToJSONKey defaultJSONKeyOptions
@@ -284,7 +347,6 @@ deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''Downlo
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''VersionInfo
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''GHCupInfo
deriveToJSON defaultOptions { sumEncoding = ObjectWithSingleField } ''URLSource
deriveJSON defaultOptions { sumEncoding = ObjectWithSingleField, constructorTagModifier = \str' -> if str' == "StackSetupURL" then str' else maybe str' T.unpack . T.stripPrefix (T.pack "S") . T.pack $ str' } ''StackSetupURLSource
deriveJSON defaultOptions { sumEncoding = ObjectWithSingleField } ''Key
deriveJSON defaultOptions { fieldLabelModifier = \str' -> maybe str' T.unpack . T.stripPrefix (T.pack "k-") . T.pack . kebab $ str' } ''UserKeyBindings
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel, unwrapUnaryRecords = True } ''Port

View File

@@ -1,90 +0,0 @@
{-# OPTIONS_GHC -Wno-orphans #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeFamilies #-}
{-|
Module : GHCup.Types.JSON.Versions
Description : GHCup Version JSON types/instances
Copyright : (c) Julian Ospald, 2020
License : LGPL-3.0
Maintainer : hasufell@hasufell.de
Stability : experimental
Portability : portable
-}
module GHCup.Types.JSON.Versions where
import Data.Aeson hiding (Key)
import Data.Aeson.Types hiding (Key)
import Data.Versions
import qualified Data.Text as T
instance ToJSON Versioning where
toJSON = toJSON . prettyV
instance FromJSON Versioning where
parseJSON = withText "Versioning" $ \t -> case versioning t of
Right x -> pure x
Left e -> fail $ "Failure in GHCTargetVersion (FromJSON)" <> show e
instance ToJSONKey Versioning where
toJSONKey = toJSONKeyText $ \x -> prettyV x
instance FromJSONKey Versioning where
fromJSONKey = FromJSONKeyTextParser $ \t -> case versioning t of
Right x -> pure x
Left e -> fail $ "Failure in Versioning (FromJSONKey)" <> show e
instance ToJSONKey (Maybe Versioning) where
toJSONKey = toJSONKeyText $ \case
Just x -> prettyV x
Nothing -> T.pack "unknown_versioning"
instance FromJSONKey (Maybe Versioning) where
fromJSONKey = FromJSONKeyTextParser $ \t ->
if t == T.pack "unknown_versioning" then pure Nothing else just t
where
just t = case versioning t of
Right x -> pure $ Just x
Left e -> fail $ "Failure in (Maybe Versioning) (FromJSONKey)" <> show e
instance ToJSONKey (Maybe Version) where
toJSONKey = toJSONKeyText $ \case
Just x -> prettyVer x
Nothing -> T.pack "unknown_version"
instance FromJSONKey (Maybe Version) where
fromJSONKey = FromJSONKeyTextParser $ \t ->
if t == T.pack "unknown_version" then pure Nothing else just t
where
just t = case version t of
Right x -> pure $ Just x
Left e -> fail $ "Failure in (Maybe Version) (FromJSONKey)" <> show e
instance ToJSON Version where
toJSON = toJSON . prettyVer
instance FromJSON Version where
parseJSON = withText "Version" $ \t -> case version t of
Right x -> pure x
Left e -> fail $ "Failure in Version (FromJSON)" <> show e
instance ToJSONKey Version where
toJSONKey = toJSONKeyText $ \x -> prettyVer x
instance FromJSONKey Version where
fromJSONKey = FromJSONKeyTextParser $ \t -> case version t of
Right x -> pure x
Left e -> fail $ "Failure in Version (FromJSONKey)" <> show e
instance ToJSON PVP where
toJSON = toJSON . prettyPVP
instance FromJSON PVP where
parseJSON = withText "PVP" $ \t -> case pvp t of
Right x -> pure x
Left e -> fail $ "Failure in PVP (FromJSON)" <> show e

View File

@@ -1,180 +0,0 @@
{-# OPTIONS_GHC -Wno-orphans #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE FlexibleInstances #-}
{-|
Module : GHCup.Types.Stack
Description : GHCup types.Stack
Copyright : (c) Julian Ospald, 2023
License : LGPL-3.0
Maintainer : hasufell@hasufell.de
Stability : experimental
Portability : portable
-}
module GHCup.Types.Stack where
import GHCup.Types.JSON.Versions ()
import Control.Applicative
import Control.DeepSeq ( NFData )
import Data.ByteString
import Data.Aeson
import Data.Aeson.Types
import Data.Map.Strict ( Map )
import Data.Text ( Text )
import Data.Text.Encoding
import Data.Versions
import qualified Data.Map as Map
import qualified GHC.Generics as GHC
--------------------------------------
--[ Stack download info copy pasta ]--
--------------------------------------
data SetupInfo = SetupInfo
{ siSevenzExe :: Maybe DownloadInfo
, siSevenzDll :: Maybe DownloadInfo
, siMsys2 :: Map Text VersionedDownloadInfo
, siGHCs :: Map Text (Map Version GHCDownloadInfo)
, siStack :: Map Text (Map Version DownloadInfo)
}
deriving (Show, Eq, GHC.Generic)
instance NFData SetupInfo
instance FromJSON SetupInfo where
parseJSON = withObject "SetupInfo" $ \o -> do
siSevenzExe <- o .:? "sevenzexe-info"
siSevenzDll <- o .:? "sevenzdll-info"
siMsys2 <- o .:? "msys2" .!= mempty
siGHCs <- o .:? "ghc" .!= mempty
siStack <- o .:? "stack" .!= mempty
pure SetupInfo {..}
instance ToJSON SetupInfo where
toJSON (SetupInfo {..}) = object [ "sevenzexe-info" .= siSevenzExe
, "sevenzdll-info" .= siSevenzDll
, "msys2" .= siMsys2
, "ghc" .= siGHCs
, "stack" .= siStack
]
-- | For the @siGHCs@ field maps are deeply merged. For all fields the values
-- from the first @SetupInfo@ win.
instance Semigroup SetupInfo where
l <> r =
SetupInfo
{ siSevenzExe = siSevenzExe l <|> siSevenzExe r
, siSevenzDll = siSevenzDll l <|> siSevenzDll r
, siMsys2 = siMsys2 l <> siMsys2 r
, siGHCs = Map.unionWith (<>) (siGHCs l) (siGHCs r)
, siStack = Map.unionWith (<>) (siStack l) (siStack r) }
instance Monoid SetupInfo where
mempty =
SetupInfo
{ siSevenzExe = Nothing
, siSevenzDll = Nothing
, siMsys2 = Map.empty
, siGHCs = Map.empty
, siStack = Map.empty
}
mappend = (<>)
-- | Build of the compiler distribution (e.g. standard, gmp4, tinfo6)
-- | Information for a file to download.
data DownloadInfo = DownloadInfo
{ downloadInfoUrl :: Text
-- ^ URL or absolute file path
, downloadInfoContentLength :: Maybe Int
, downloadInfoSha1 :: Maybe ByteString
, downloadInfoSha256 :: Maybe ByteString
}
deriving (Show, Eq, GHC.Generic)
instance ToJSON DownloadInfo where
toJSON (DownloadInfo {..}) = object [ "url" .= downloadInfoUrl
, "content-length" .= downloadInfoContentLength
, "sha1" .= (decodeUtf8 <$> downloadInfoSha1)
, "sha256" .= (decodeUtf8 <$> downloadInfoSha256)
]
instance NFData DownloadInfo
instance FromJSON DownloadInfo where
parseJSON = withObject "DownloadInfo" parseDownloadInfoFromObject
-- | Parse JSON in existing object for 'DownloadInfo'
parseDownloadInfoFromObject :: Object -> Parser DownloadInfo
parseDownloadInfoFromObject o = do
url <- o .: "url"
contentLength <- o .:? "content-length"
sha1TextMay <- o .:? "sha1"
sha256TextMay <- o .:? "sha256"
pure
DownloadInfo
{ downloadInfoUrl = url
, downloadInfoContentLength = contentLength
, downloadInfoSha1 = fmap encodeUtf8 sha1TextMay
, downloadInfoSha256 = fmap encodeUtf8 sha256TextMay
}
data VersionedDownloadInfo = VersionedDownloadInfo
{ vdiVersion :: Version
, vdiDownloadInfo :: DownloadInfo
}
deriving (Show, Eq, GHC.Generic)
instance ToJSON VersionedDownloadInfo where
toJSON (VersionedDownloadInfo {vdiDownloadInfo = DownloadInfo{..}, ..})
= object [ "version" .= vdiVersion
, "url" .= downloadInfoUrl
, "content-length" .= downloadInfoContentLength
, "sha1" .= (decodeUtf8 <$> downloadInfoSha1)
, "sha256" .= (decodeUtf8 <$> downloadInfoSha256)
]
instance NFData VersionedDownloadInfo
instance FromJSON VersionedDownloadInfo where
parseJSON = withObject "VersionedDownloadInfo" $ \o -> do
ver' <- o .: "version"
downloadInfo <- parseDownloadInfoFromObject o
pure VersionedDownloadInfo
{ vdiVersion = ver'
, vdiDownloadInfo = downloadInfo
}
data GHCDownloadInfo = GHCDownloadInfo
{ gdiConfigureOpts :: [Text]
, gdiConfigureEnv :: Map Text Text
, gdiDownloadInfo :: DownloadInfo
}
deriving (Show, Eq, GHC.Generic)
instance NFData GHCDownloadInfo
instance ToJSON GHCDownloadInfo where
toJSON (GHCDownloadInfo {gdiDownloadInfo = DownloadInfo {..}, ..})
= object [ "configure-opts" .= gdiConfigureOpts
, "configure-env" .= gdiConfigureEnv
, "url" .= downloadInfoUrl
, "content-length" .= downloadInfoContentLength
, "sha1" .= (decodeUtf8 <$> downloadInfoSha1)
, "sha256" .= (decodeUtf8 <$> downloadInfoSha256)
]
instance FromJSON GHCDownloadInfo where
parseJSON = withObject "GHCDownloadInfo" $ \o -> do
configureOpts <- o .:? "configure-opts" .!= mempty
configureEnv <- o .:? "configure-env" .!= mempty
downloadInfo <- parseDownloadInfoFromObject o
pure GHCDownloadInfo
{ gdiConfigureOpts = configureOpts
, gdiConfigureEnv = configureEnv
, gdiDownloadInfo = downloadInfo
}

View File

@@ -49,6 +49,7 @@ import GHCup.Prelude.Logger.Internal
import GHCup.Prelude.MegaParsec
import GHCup.Prelude.Process
import GHCup.Prelude.String.QQ
import Codec.Archive hiding ( Directory )
import Control.Applicative
import Control.Exception.Safe
@@ -91,7 +92,7 @@ import qualified Data.List.NonEmpty as NE
import qualified Streamly.Prelude as S
import Control.DeepSeq (force)
import GHC.IO (evaluate)
import System.Environment (getEnvironment)
import System.Environment (getEnvironment, setEnv)
import Data.Time (Day(..), diffDays, addDays)
@@ -118,11 +119,11 @@ import Data.Time (Day(..), diffDays, addDays)
-- >>> let lc = LoggerConfig { lcPrintDebug = False, consoleOutter = mempty, fileOutter = mempty, fancyColors = False }
-- >>> dirs' <- getAllDirs
-- >>> let installedVersions = [ ([pver|8.10.7|], "-debug+lol", Nothing), ([pver|8.10.4|], "", Nothing), ([pver|8.8.4|], "", Nothing), ([pver|8.8.3|], "", Nothing) ]
-- >>> let settings = defaultSettings { cache = True, metaCache = 0, noNetwork = True }
-- >>> let settings = Settings True 0 False Never Curl False GHCupURL True GPGNone False
-- >>> let leanAppState = LeanAppState settings dirs' defaultKeyBindings lc
-- >>> cwd <- getCurrentDirectory
-- >>> (Right ref) <- pure $ parseURI strictURIParserOptions $ "file://" <> E.encodeUtf8 (T.pack cwd) <> "/data/metadata/" <> (urlBaseName . view pathL' $ ghcupURL)
-- >>> (VRight r) <- (fmap . fmap) _ghcupDownloads $ flip runReaderT leanAppState . runE @'[DigestError, GPGError, JSONError , DownloadFailed , FileDoesNotExistError, ContentLengthError] $ liftE $ getBase ref
-- >>> (VRight r) <- (fmap . fmap) _ghcupDownloads $ flip runReaderT leanAppState . runE @'[DigestError, GPGError, JSONError , DownloadFailed , FileDoesNotExistError] $ liftE $ getBase ref
@@ -693,8 +694,10 @@ hlsAllBinaries ver = do
-- | Extract (major, minor) from any version.
getMajorMinorV :: MonadThrow m => Version -> m (Int, Int)
getMajorMinorV (Version _ (Chunks (Numeric x :| Numeric y : _)) _ _) = pure (fromIntegral x, fromIntegral y)
getMajorMinorV _ = throwM $ ParseError "Could not parse X.Y from version"
getMajorMinorV Version {..} = case _vChunks of
((Digits x :| []) :| ((Digits y :| []):_)) -> pure (fromIntegral x, fromIntegral y)
_ -> throwM $ ParseError "Could not parse X.Y from version"
matchMajor :: Version -> Int -> Int -> Bool
matchMajor v' major' minor' = case getMajorMinorV v' of
@@ -736,7 +739,7 @@ getGHCForPVP pvpIn mt = do
-- | Like 'getGHCForPVP', except with explicit input parameter.
--
-- >>> getGHCForPVP' [pver|8|] installedVersions Nothing
-- Just (GHCTargetVersion {_tvTarget = Nothing, _tvVersion = Version {_vEpoch = Nothing, _vChunks = Chunks (Numeric 8 :| [Numeric 10,Numeric 7]), _vRel = Just (Release (Alphanum "debug" :| [])), _vMeta = Just "lol"}})
-- Just (GHCTargetVersion {_tvTarget = Nothing, _tvVersion = Version {_vEpoch = Nothing, _vChunks = (Digits 8 :| []) :| [Digits 10 :| [],Digits 7 :| []], _vRel = [Str "debug" :| []], _vMeta = Just "lol"}})
-- >>> fmap prettyShow $ getGHCForPVP' [pver|8.8|] installedVersions Nothing
-- "Just 8.8.4"
-- >>> fmap prettyShow $ getGHCForPVP' [pver|8.10.4|] installedVersions Nothing
@@ -762,11 +765,11 @@ getGHCForPVP' pvpIn ghcs' mt = do
-- | Get the latest available ghc for the given PVP version, which
-- may only contain parts.
--
-- >>> (fmap . fmap) (\(p, _, _) -> p) $ getLatestToolFor GHC Nothing [pver|8|] r
-- >>> (fmap . fmap) fst $ getLatestToolFor GHC [pver|8|] r
-- Just (PVP {_pComponents = 8 :| [10,7]})
-- >>> (fmap . fmap) (\(p, _, _) -> p) $ getLatestToolFor GHC Nothing [pver|8.8|] r
-- >>> (fmap . fmap) fst $ getLatestToolFor GHC [pver|8.8|] r
-- Just (PVP {_pComponents = 8 :| [8,4]})
-- >>> (fmap . fmap) (\(p, _, _) -> p) $ getLatestToolFor GHC Nothing [pver|8.8.4|] r
-- >>> (fmap . fmap) fst $ getLatestToolFor GHC [pver|8.8.4|] r
-- Just (PVP {_pComponents = 8 :| [8,4]})
getLatestToolFor :: MonadThrow m
=> Tool
@@ -1037,7 +1040,7 @@ applyPatches pdir ddir = do
patches <- liftIO $ quilt `catchIO` (\e ->
if isDoesNotExistError e || isPermissionError e then
lexicographical
lexicographical
else throwIO e)
forM_ patches $ \patch' -> applyPatch patch' ddir
@@ -1085,7 +1088,7 @@ darwinNotarization :: (MonadReader env m, HasDirs env, MonadIO m)
-> FilePath
-> m (Either ProcessError ())
darwinNotarization Darwin path = exec
"/usr/bin/xattr"
"xattr"
["-r", "-d", "com.apple.quarantine", path]
Nothing
Nothing
@@ -1320,27 +1323,20 @@ warnAboutHlsCompatibility = do
addToPath :: [FilePath]
addToPath :: FilePath
-> Bool -- ^ if False will prepend
-> IO [(String, String)]
addToPath paths append = do
cEnv <- getEnvironment
return $ addToPath' cEnv paths append
addToPath' :: [(String, String)]
-> [FilePath]
-> Bool -- ^ if False will prepend
-> [(String, String)]
addToPath' cEnv' newPaths append =
let cEnv = Map.fromList cEnv'
paths = ["PATH", "Path"]
curPaths = (\x -> maybe [] splitSearchPath (Map.lookup x cEnv)) =<< paths
{- HLINT ignore "Redundant bracket" -}
newPath = intercalate [searchPathSeparator] (if append then (curPaths ++ newPaths) else (newPaths ++ curPaths))
envWithoutPath = foldr (\x y -> Map.delete x y) cEnv paths
pathVar = if isWindows then "Path" else "PATH"
envWithNewPath = Map.toList $ Map.insert pathVar newPath envWithoutPath
in envWithNewPath
addToPath path append = do
cEnv <- Map.fromList <$> getEnvironment
let paths = ["PATH", "Path"]
curPaths = (\x -> maybe [] splitSearchPath (Map.lookup x cEnv)) =<< paths
{- HLINT ignore "Redundant bracket" -}
newPath = intercalate [searchPathSeparator] (if append then (curPaths ++ [path]) else (path : curPaths))
envWithoutPath = foldr (\x y -> Map.delete x y) cEnv paths
pathVar = if isWindows then "Path" else "PATH"
envWithNewPath = Map.toList $ Map.insert pathVar newPath envWithoutPath
liftIO $ setEnv pathVar newPath
return envWithNewPath
-----------

View File

@@ -24,20 +24,17 @@ import qualified Data.Text as T
import qualified Data.Versions as V
import Control.Exception.Safe (MonadThrow)
import Data.Text (Text)
import Data.List.NonEmpty (NonEmpty((:|)))
import Data.List (intersperse)
import Control.Monad.Catch (throwM)
import GHCup.Errors (ParseError(..))
import Text.Megaparsec
import Data.Void (Void)
-- | This reflects the API version of the YAML.
--
-- Note that when updating this, CI requires that the file exsists AND the same file exists at
-- 'https://www.haskell.org/ghcup/exp/ghcup-<ver>.yaml' with some newlines added.
ghcupURL :: URI
ghcupURL = [uri|https://raw.githubusercontent.com/haskell/ghcup-metadata/master/ghcup-0.0.8.yaml|]
stackSetupURL :: URI
stackSetupURL = [uri|https://raw.githubusercontent.com/commercialhaskell/stackage-content/master/stack/stack-setup-2.yaml|]
ghcupURL = [uri|https://raw.githubusercontent.com/haskell/ghcup-metadata/master/ghcup-0.0.7.yaml|]
-- | The current ghcup version.
ghcUpVer :: V.PVP
@@ -56,7 +53,7 @@ versionCmp ver1 (VR_eq ver2) = ver1 == ver2
versionRange :: V.Versioning -> VersionRange -> Bool
versionRange ver' (SimpleRange cmps) = all (versionCmp ver') cmps
versionRange ver' (OrRange cmps range) =
versionRange ver' (OrRange cmps range) =
versionRange ver' (SimpleRange cmps) || versionRange ver' range
pvpToVersion :: MonadThrow m => V.PVP -> Text -> m V.Version
@@ -68,15 +65,44 @@ pvpToVersion pvp_ rest =
-- -- prop> \v -> let (Just (pvp', r)) = versionToPVP v in pvpToVersion pvp' r === Just v
versionToPVP :: MonadThrow m => V.Version -> m (V.PVP, Text)
versionToPVP (V.Version (Just _) _ _ _) = throwM $ ParseError "Unexpected epoch"
versionToPVP v = case parse pvp'' "Version->PVP" $ V.prettyVer v of
Left _ -> throwM $ ParseError "Couldn't convert Version to PVP"
Right r -> pure r
versionToPVP v = either (\_ -> (, rest v) <$> alternative v) (pure . (, mempty)) . V.pvp . V.prettyVer $ v
where
pvp'' :: Parsec Void T.Text (V.PVP, T.Text)
pvp'' = do
p <- V.pvp'
s <- getParserState
pure (p, stateInput s)
alternative :: MonadThrow m => V.Version -> m V.PVP
alternative v' = case NE.takeWhile isDigit (V._vChunks v') of
[] -> throwM $ ParseError "Couldn't convert Version to PVP"
xs -> pure $ pvpFromList (unsafeDigit <$> xs)
rest :: V.Version -> Text
rest (V.Version _ cs pr me) =
let chunks = NE.dropWhile isDigit cs
ver = intersperse (T.pack ".") . chunksAsT $ chunks
me' = maybe [] (\m -> [T.pack "+",m]) me
pr' = foldable [] (T.pack "-" :) $ intersperse (T.pack ".") (chunksAsT pr)
prefix = case (ver, pr', me') of
(_:_, _, _) -> T.pack "."
_ -> T.pack ""
in prefix <> mconcat (ver <> pr' <> me')
where
chunksAsT :: Functor t => t V.VChunk -> t Text
chunksAsT = fmap (foldMap f)
where
f :: V.VUnit -> Text
f (V.Digits i) = T.pack $ show i
f (V.Str s) = s
foldable :: Foldable f => f b -> (f a -> f b) -> f a -> f b
foldable d g f | null f = d
| otherwise = g f
isDigit :: V.VChunk -> Bool
isDigit (V.Digits _ :| []) = True
isDigit _ = False
unsafeDigit :: V.VChunk -> Int
unsafeDigit (V.Digits x :| []) = fromIntegral x
unsafeDigit _ = error "unsafeDigit: wrong input"
pvpFromList :: [Int] -> V.PVP
pvpFromList = V.PVP . NE.fromList . fmap fromIntegral

View File

@@ -1,4 +1,4 @@
resolver: lts-20.26
resolver: lts-20.20
packages:
- .
@@ -24,8 +24,6 @@ extra-deps:
- strict-base-0.4.0.0
- text-2.0.2
- yaml-streamly-0.12.2
- github: fosskers/versions
commit: 7bc3355348aac3510771d4622aff09ac38c9924d
flags:
http-io-streams:

File diff suppressed because it is too large Load Diff

View File

@@ -1,6 +1,3 @@
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE OverloadedStrings #-}
module ChangeLogTest where
import Test.Tasty
@@ -9,7 +6,8 @@ import Utils
import Test.Tasty.HUnit
import Control.Monad.IO.Class
import GHCup.Types
import Data.Versions (versionQ)
import Data.Versions
import Data.List.NonEmpty (NonEmpty ((:|)))
changeLogTests :: TestTree
changeLogTests = testGroup "changelog" $ map (uncurry check) checkList
@@ -32,7 +30,7 @@ checkList =
(Just $ GHCVersion
$ GHCTargetVersion
Nothing
$(versionQ "9.2"))
(mkVersion $ (Digits 9 :| []) :| [Digits 2 :| []]))
)
, ("changelog recommended", ChangeLogOptions False Nothing (Just $ ToolTag Recommended))
, ("changelog -t cabal recommended", ChangeLogOptions False (Just Cabal) (Just $ ToolTag Recommended))
@@ -40,7 +38,7 @@ checkList =
(Just $ GHCVersion
$ GHCTargetVersion
Nothing
$(versionQ "3.10.1.0"))
(mkVersion $ (Digits 3 :| []) :| [Digits 10 :| [],Digits 1 :| [],Digits 0 :| []]))
)
, ("changelog 2023-07-22", ChangeLogOptions False Nothing (Just (ToolDay (read "2023-07-22"))))
]

View File

@@ -1,7 +1,6 @@
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE TemplateHaskell #-}
module CompileTest where
@@ -60,12 +59,12 @@ compileGhcCheckList = mapSecond CompileGHC
[ ("compile ghc -v 9.4.5 -b 9.2.8", baseOptions)
, ("compile ghc -g a32db0b -b 9.2.8", mkDefaultGHCCompileOptions
(GHC.GitDist $ GitBranch "a32db0b" Nothing)
(Left $(versionQ "9.2.8"))
(Left $ mkVersion' "9.2.8")
)
, ("compile ghc -g a32db0b -b 9.2.8 -r https://gitlab.haskell.org/ghc/ghc.git",
mkDefaultGHCCompileOptions
(GHC.GitDist $ GitBranch "a32db0b" (Just "https://gitlab.haskell.org/ghc/ghc.git"))
(Left $(versionQ "9.2.8"))
(Left $ mkVersion' "9.2.8")
)
, ("compile ghc -g a32db0b -r https://gitlab.haskell.org/ghc/ghc.git -b /usr/bin/ghc-9.2.2",
mkDefaultGHCCompileOptions
@@ -74,7 +73,7 @@ compileGhcCheckList = mapSecond CompileGHC
)
, ("compile ghc --remote-source-dist https://gitlab.haskell.org/ghc/ghc.git -b 9.2.8", mkDefaultGHCCompileOptions
(GHC.RemoteDist [uri|https://gitlab.haskell.org/ghc/ghc.git|])
(Left $(versionQ "9.2.8"))
(Left $ mkVersion' "9.2.8")
)
, (baseCmd <> "-j20", baseOptions{GHC.jobs = Just 20})
, (baseCmd <> "--jobs 10", baseOptions{GHC.jobs = Just 10})
@@ -87,8 +86,8 @@ compileGhcCheckList = mapSecond CompileGHC
, (baseCmd <> "--cross-target armv7-unknown-linux-gnueabihf", baseOptions{GHC.crossTarget = Just "armv7-unknown-linux-gnueabihf"})
, (baseCmd <> "-- --enable-unregisterised", baseOptions{GHC.addConfArgs = ["--enable-unregisterised"]})
, (baseCmd <> "--set", baseOptions{GHC.setCompile = True})
, (baseCmd <> "-o 9.4.5-p1", baseOptions{GHC.ovewrwiteVer = Just $(versionQ "9.4.5-p1")})
, (baseCmd <> "--overwrite-version 9.4.5-p1", baseOptions{GHC.ovewrwiteVer = Just $(versionQ "9.4.5-p1")})
, (baseCmd <> "-o 9.4.5-p1", baseOptions{GHC.ovewrwiteVer = Just $ mkVersion' "9.4.5-p1"})
, (baseCmd <> "--overwrite-version 9.4.5-p1", baseOptions{GHC.ovewrwiteVer = Just $ mkVersion' "9.4.5-p1"})
, (baseCmd <> "-f make", baseOptions{GHC.buildFlavour = Just "make"})
, (baseCmd <> "--flavour make", baseOptions{GHC.buildFlavour = Just "make"})
, (baseCmd <> "--hadrian", baseOptions{GHC.buildSystem = Just Hadrian})
@@ -108,8 +107,8 @@ compileGhcCheckList = mapSecond CompileGHC
baseOptions :: GHCCompileOptions
baseOptions =
mkDefaultGHCCompileOptions
(GHC.SourceDist $(versionQ "9.4.5"))
(Left $(versionQ "9.2.8"))
(GHC.SourceDist $ mkVersion' "9.4.5")
(Left $ mkVersion' "9.2.8")
compileHlsCheckList :: [(String, CompileCommand)]
compileHlsCheckList = mapSecond CompileHLS
@@ -137,7 +136,7 @@ compileHlsCheckList = mapSecond CompileHLS
)
, ("compile hls --source-dist 2.0.0.0 --ghc 9.2.8",
mkDefaultHLSCompileOptions
(HLS.SourceDist $(versionQ "2.0.0.0"))
(HLS.SourceDist $ mkVersion' "2.0.0.0")
[ghc928]
)
, ("compile hls --remote-source-dist https://github.com/haskell/haskell-language-server/archive/refs/tags/2.0.0.1.tar.gz --ghc 9.2.8",
@@ -147,15 +146,15 @@ compileHlsCheckList = mapSecond CompileHLS
)
, ("compile hls -v 2.0.0.0 --ghc latest",
mkDefaultHLSCompileOptions
(HLS.HackageDist $(versionQ "2.0.0.0"))
(HLS.HackageDist $ mkVersion' "2.0.0.0")
[ToolTag Latest]
)
, (baseCmd <> "-j20", baseOptions{HLS.jobs = Just 20})
, (baseCmd <> "--jobs 10", baseOptions{HLS.jobs = Just 10})
, (baseCmd <> "--no-set", baseOptions{HLS.setCompile = False})
, (baseCmd <> "--cabal-update", baseOptions{HLS.updateCabal = True})
, (baseCmd <> "-o 2.0.0.0-p1", baseOptions{HLS.ovewrwiteVer = Right $(versionQ "2.0.0.0-p1")})
, (baseCmd <> "--overwrite-version 2.0.0.0-p1", baseOptions{HLS.ovewrwiteVer = Right $(versionQ "2.0.0.0-p1")})
, (baseCmd <> "-o 2.0.0.0-p1", baseOptions{HLS.ovewrwiteVer = Right $ mkVersion' "2.0.0.0-p1"})
, (baseCmd <> "--overwrite-version 2.0.0.0-p1", baseOptions{HLS.ovewrwiteVer = Right $ mkVersion' "2.0.0.0-p1"})
, (baseCmd <> "--git-describe-version", baseOptions{HLS.ovewrwiteVer = Left True})
#ifdef IS_WINDOWS
, (baseCmd <> "-i C:\\\\tmp\\out_dir", baseOptions{HLS.isolateDir = Just "C:\\\\tmp\\out_dir"})
@@ -179,11 +178,11 @@ compileHlsCheckList = mapSecond CompileHLS
baseOptions :: HLSCompileOptions
baseOptions =
mkDefaultHLSCompileOptions
(HLS.HackageDist $(versionQ "2.0.0.0"))
(HLS.HackageDist $ mkVersion' "2.0.0.0")
[ghc928]
ghc928 :: ToolVersion
ghc928 = GHCVersion $ GHCTargetVersion Nothing $(versionQ "9.2.8")
ghc928 = GHCVersion $ GHCTargetVersion Nothing (mkVersion' "9.2.8")
compileParseWith :: [String] -> IO CompileCommand
compileParseWith args = do

View File

@@ -1,10 +1,6 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE NamedFieldPuns #-}
module InstallTest where
@@ -16,8 +12,6 @@ import Data.Versions
import Data.List.NonEmpty (NonEmpty ((:|)))
import GHCup.OptParse.Install as Install
import URI.ByteString.QQ
import URI.ByteString
import Data.Text (Text)
-- Some interests:
-- install ghc *won't* select `set as activate version` as default
@@ -31,193 +25,199 @@ installTests = testGroup "install"
(buildTestTree installParseWith)
[ ("old-style", oldStyleCheckList)
, ("ghc", installGhcCheckList)
, ("cabal", (fmap . fmap . fmap) toGHCOptions installCabalCheckList)
, ("hls", (fmap . fmap . fmap) toGHCOptions installHlsCheckList)
, ("stack", (fmap . fmap . fmap) toGHCOptions installStackCheckList)
, ("cabal", installCabalCheckList)
, ("hls", installHlsCheckList)
, ("stack", installStackCheckList)
]
toGHCOptions :: InstallOptions -> InstallGHCOptions
toGHCOptions InstallOptions{..}
= InstallGHCOptions instVer
instBindist
instSet
isolateDir
forceInstall
addConfArgs
Nothing
defaultOptions :: InstallOptions
defaultOptions = InstallOptions Nothing Nothing False Nothing False []
defaultGHCOptions :: InstallGHCOptions
defaultGHCOptions = InstallGHCOptions Nothing Nothing False Nothing False [] Nothing
-- | Don't set as active version
mkInstallOptions :: ToolVersion -> InstallGHCOptions
mkInstallOptions ver = InstallGHCOptions (Just ver) Nothing False Nothing False [] Nothing
mkInstallOptions :: ToolVersion -> InstallOptions
mkInstallOptions ver = InstallOptions (Just ver) Nothing False Nothing False []
-- | Set as active version
mkInstallOptions' :: ToolVersion -> InstallOptions
mkInstallOptions' ver = InstallOptions (Just ver) Nothing True Nothing False []
oldStyleCheckList :: [(String, Either InstallCommand InstallGHCOptions)]
oldStyleCheckList :: [(String, Either InstallCommand InstallOptions)]
oldStyleCheckList =
("install", Right defaultGHCOptions)
: ("install --set", Right (defaultGHCOptions{instSet = True} :: InstallGHCOptions))
: ("install --force", Right (defaultGHCOptions{forceInstall = True} :: InstallGHCOptions))
("install", Right defaultOptions)
: ("install --set", Right defaultOptions{instSet = True})
: ("install --force", Right defaultOptions{forceInstall = True})
#ifdef IS_WINDOWS
: ("install -i C:\\\\", Right (defaultGHCOptions{Install.isolateDir = Just "C:\\\\"} :: InstallGHCOptions))
: ("install -i C:\\\\", Right defaultOptions{Install.isolateDir = Just "C:\\\\"})
#else
: ("install -i /", Right (defaultGHCOptions{Install.isolateDir = Just "/"} :: InstallGHCOptions))
: ("install -i /", Right defaultOptions{Install.isolateDir = Just "/"})
#endif
: ("install -u https://gitlab.haskell.org/ghc/ghc/-/jobs/artifacts/master/raw/ghc-x86_64-linux-fedora33-release.tar.xz head"
, Right (defaultGHCOptions
, Right defaultOptions
{ instBindist = Just [uri|https://gitlab.haskell.org/ghc/ghc/-/jobs/artifacts/master/raw/ghc-x86_64-linux-fedora33-release.tar.xz|]
, instVer = Just $ GHCVersion $ GHCTargetVersion Nothing $(versionQ "head")
} :: InstallGHCOptions)
, instVer = Just $ GHCVersion $ GHCTargetVersion Nothing (mkVersion $ (Str "head" :| []) :| [])
}
)
: mapSecond
(Right . mkInstallOptions)
[ ("install ghc-9.2", GHCVersion
$ GHCTargetVersion
(Just "ghc")
$(versionQ "9.2")
(mkVersion $ (Digits 9 :| []) :| [Digits 2 :| []])
)
-- invalid
, ("install next", GHCVersion
$ GHCTargetVersion
Nothing
$(versionQ "next")
(mkVersion $ (Str "next" :| []) :| [])
)
, ("install latest", ToolTag Latest)
, ("install nightly", GHCVersion
$ GHCTargetVersion
Nothing
$(versionQ "nightly")
(mkVersion $ (Str "nightly" :| []) :| [])
)
, ("install recommended", ToolTag Recommended)
, ("install prerelease", GHCVersion
$ GHCTargetVersion
Nothing
$(versionQ "prerelease")
(mkVersion $ (Str "prerelease" :| []) :| [])
)
, ("install latest-prerelease", ToolTag LatestPrerelease)
, ("install latest-nightly", ToolTag LatestNightly)
, ("install ghc-javascript-unknown-ghcjs-9.6", GHCVersion
$ GHCTargetVersion
(Just "ghc-javascript-unknown-ghcjs")
$(versionQ "9.6")
(mkVersion $ (Digits 9 :| []) :| [Digits 6 :| []])
)
, ("install base-4.18", ToolTag (Base (PVP {_pComponents = 4 :| [18]})))
, ("install cabal-3.10", GHCVersion
$ GHCTargetVersion
(Just "cabal")
$(versionQ "3.10")
(mkVersion $ (Digits 3 :| []) :| [Digits 10 :| []])
)
, ("install hls-2.0.0.0", GHCVersion
$ GHCTargetVersion
(Just "hls")
$(versionQ "2.0.0.0")
(mkVersion $ (Digits 2 :| []) :| [Digits 0 :| [], Digits 0 :| [], Digits 0 :| []])
)
, ("install stack-2.9.3", GHCVersion
$ GHCTargetVersion
(Just "stack")
$(versionQ "2.9.3")
(mkVersion $ (Digits 2 :| []) :| [Digits 9 :| [], Digits 3 :| []])
)
]
installGhcCheckList :: [(String, Either InstallCommand InstallGHCOptions)]
installGhcCheckList :: [(String, Either InstallCommand InstallOptions)]
installGhcCheckList =
("install ghc", Left $ InstallGHC defaultGHCOptions)
("install ghc", Left $ InstallGHC defaultOptions)
: mapSecond (Left . InstallGHC . mkInstallOptions)
[ ("install ghc 9.2", GHCVersion
$ GHCTargetVersion
Nothing
$(versionQ "9.2")
(mkVersion $ (Digits 9 :| []) :| [Digits 2 :| []])
)
, ("install ghc next", GHCVersion
$ GHCTargetVersion
Nothing
$(versionQ "next")
(mkVersion $ (Str "next" :| []) :| [])
)
, ("install ghc latest", ToolTag Latest)
, ("install ghc nightly", GHCVersion
$ GHCTargetVersion
Nothing
$(versionQ "nightly")
(mkVersion $ (Str "nightly" :| []) :| [])
)
, ("install ghc recommended", ToolTag Recommended)
, ("install ghc prerelease", GHCVersion
$ GHCTargetVersion
Nothing
$(versionQ "prerelease")
(mkVersion $ (Str "prerelease" :| []) :| [])
)
, ("install ghc latest-prerelease", ToolTag LatestPrerelease)
, ("install ghc latest-nightly", ToolTag LatestNightly)
, ("install ghc javascript-unknown-ghcjs-9.6", GHCVersion
$ GHCTargetVersion
(Just "javascript-unknown-ghcjs")
$(versionQ "9.6")
(mkVersion $ (Digits 9 :| []) :| [Digits 6 :| []])
)
, ("install ghc base-4.18", ToolTag (Base (PVP {_pComponents = 4 :| [18]})))
, ("install ghc ghc-9.2", GHCVersion
$ GHCTargetVersion
(Just "ghc")
$(versionQ "9.2")
(mkVersion $ (Digits 9 :| []) :| [Digits 2 :| []])
)
]
installCabalCheckList :: [(String, Either InstallCommand InstallOptions)]
installCabalCheckList =
("install cabal", Left $ InstallCabal (defaultOptions{instSet = True} :: InstallOptions))
("install cabal", Left $ InstallCabal defaultOptions{instSet = True})
: mapSecond (Left . InstallCabal . mkInstallOptions')
[ ("install cabal 3.10", ToolVersion $(versionQ "3.10"))
, ("install cabal next", ToolVersion $(versionQ "next"))
[ ("install cabal 3.10", ToolVersion $ mkVersion $ (Digits 3 :| []) :| [Digits 10 :| []])
, ("install cabal next", ToolVersion $ mkVersion $ (Str "next" :| []) :| [])
, ("install cabal latest", ToolTag Latest)
, ("install cabal nightly", ToolVersion $(versionQ "nightly"))
, ("install cabal nightly", ToolVersion $ mkVersion $ (Str "nightly" :| []) :| [])
, ("install cabal recommended", ToolTag Recommended)
, ("install cabal prerelease", ToolVersion $(versionQ "prerelease"))
, ("install cabal prerelease", ToolVersion $ mkVersion $ (Str "prerelease" :| []) :| [])
, ("install cabal latest-prerelease", ToolTag LatestPrerelease)
, ("install cabal latest-nightly", ToolTag LatestNightly)
, ("install cabal base-4.18", ToolTag (Base (PVP {_pComponents = 4 :| [18]})))
, ("install cabal cabal-3.10", ToolVersion $(versionQ "cabal-3.10"))
, ("install cabal cabal-3.10", ToolVersion
$ Version
{ _vEpoch = Nothing
, _vChunks = (Str "cabal" :| []) :| []
, _vRel = [Digits 3 :| [], Digits 10 :| []]
, _vMeta = Nothing
}
)
]
installHlsCheckList :: [(String, Either InstallCommand InstallOptions)]
installHlsCheckList =
("install hls", Left $ InstallHLS defaultOptions{instSet = True})
: mapSecond (Left . InstallHLS . mkInstallOptions')
[ ("install hls 3.10", ToolVersion $(versionQ "3.10"))
, ("install hls next", ToolVersion $(versionQ "next"))
[ ("install hls 3.10", ToolVersion $ mkVersion $ (Digits 3 :| []) :| [Digits 10 :| []])
, ("install hls next", ToolVersion $ mkVersion $ (Str "next" :| []) :| [])
, ("install hls latest", ToolTag Latest)
, ("install hls nightly", ToolVersion $(versionQ "nightly"))
, ("install hls nightly", ToolVersion $ mkVersion $ (Str "nightly" :| []) :| [])
, ("install hls recommended", ToolTag Recommended)
, ("install hls prerelease", ToolVersion $(versionQ "prerelease"))
, ("install hls prerelease", ToolVersion $ mkVersion $ (Str "prerelease" :| []) :| [])
, ("install hls latest-prerelease", ToolTag LatestPrerelease)
, ("install hls latest-nightly", ToolTag LatestNightly)
, ("install hls base-4.18", ToolTag (Base (PVP {_pComponents = 4 :| [18]})))
, ("install hls hls-2.0", ToolVersion $(versionQ "hls-2.0"))
, ("install hls hls-2.0", ToolVersion
$ Version
{ _vEpoch = Nothing
, _vChunks = (Str "hls" :| []) :| []
, _vRel = [Digits 2 :| [], Digits 0 :| []]
, _vMeta = Nothing
}
)
]
installStackCheckList :: [(String, Either InstallCommand InstallOptions)]
installStackCheckList =
("install stack", Left $ InstallStack defaultOptions{instSet = True})
: mapSecond (Left . InstallStack . mkInstallOptions')
[ ("install stack 3.10", ToolVersion $(versionQ "3.10"))
, ("install stack next", ToolVersion $(versionQ "next"))
[ ("install stack 3.10", ToolVersion $ mkVersion $ (Digits 3 :| []) :| [Digits 10 :| []])
, ("install stack next", ToolVersion $ mkVersion $ (Str "next" :| []) :| [])
, ("install stack latest", ToolTag Latest)
, ("install stack nightly", ToolVersion $(versionQ "nightly"))
, ("install stack nightly", ToolVersion $ mkVersion $ (Str "nightly" :| []) :| [])
, ("install stack recommended", ToolTag Recommended)
, ("install stack prerelease", ToolVersion $(versionQ "prerelease"))
, ("install stack prerelease", ToolVersion $ mkVersion $ (Str "prerelease" :| []) :| [])
, ("install stack latest-prerelease", ToolTag LatestPrerelease)
, ("install stack latest-nightly", ToolTag LatestNightly)
, ("install stack base-4.18", ToolTag (Base (PVP {_pComponents = 4 :| [18]})))
, ("install stack stack-2.9", ToolVersion $(versionQ "stack-2.9"))
, ("install stack stack-2.9", ToolVersion
$ Version
{ _vEpoch = Nothing
, _vChunks = (Str "stack" :| []) :| []
, _vRel = [Digits 2 :| [], Digits 9 :| []]
, _vMeta = Nothing
}
)
]
installParseWith :: [String] -> IO (Either InstallCommand InstallGHCOptions)
installParseWith :: [String] -> IO (Either InstallCommand InstallOptions)
installParseWith args = do
Install a <- parseWith args
pure a

View File

@@ -1,5 +1,4 @@
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
module RmTest where
@@ -7,6 +6,7 @@ import Test.Tasty
import GHCup.OptParse
import Utils
import GHCup.Types
import Data.List.NonEmpty (NonEmpty ((:|)))
import Data.Versions
@@ -24,36 +24,54 @@ rmTests =
oldStyleCheckList :: [(String, Either RmCommand RmOptions)]
oldStyleCheckList = mapSecond (Right . RmOptions)
[ -- failed with ("rm", xxx)
("rm 9.2.8", mkTVer $(versionQ "9.2.8"))
, ("rm ghc-9.2.8", GHCTargetVersion (Just "ghc") $(versionQ "9.2.8"))
("rm 9.2.8", mkTVer (mkVersion $ (Digits 9 :| []) :| [Digits 2 :| [], Digits 8 :| []]))
, ("rm ghc-9.2.8", GHCTargetVersion (Just "ghc") (mkVersion $ (Digits 9 :| []) :| [Digits 2 :| [], Digits 8 :| []]))
]
rmGhcCheckList :: [(String, Either RmCommand RmOptions)]
rmGhcCheckList = mapSecond (Left . RmGHC . RmOptions)
[ -- failed with ("rm ghc", xxx)
("rm ghc 9.2.8", mkTVer $(versionQ "9.2.8"))
, ("rm ghc ghc-9.2.8", GHCTargetVersion (Just "ghc") $(versionQ "9.2.8"))
("rm ghc 9.2.8", mkTVer (mkVersion $ (Digits 9 :| []) :| [Digits 2 :| [], Digits 8 :| []]))
, ("rm ghc ghc-9.2.8", GHCTargetVersion (Just "ghc") (mkVersion $ (Digits 9 :| []) :| [Digits 2 :| [], Digits 8 :| []]))
]
rmCabalCheckList :: [(String, Either RmCommand RmOptions)]
rmCabalCheckList = mapSecond (Left . RmCabal)
[ -- failed with ("rm cabal", xxx)
("rm cabal 3.10", $(versionQ "3.10"))
, ("rm cabal cabal-3.10", $(versionQ "cabal-3.10"))
("rm cabal 3.10", mkVersion $ (Digits 3 :| []) :| [Digits 10 :| []])
, ("rm cabal cabal-3.10", Version
{ _vEpoch = Nothing
, _vChunks = (Str "cabal" :| []) :| []
, _vRel = [Digits 3 :| [], Digits 10 :| []]
, _vMeta = Nothing
}
)
]
rmHlsCheckList :: [(String, Either RmCommand RmOptions)]
rmHlsCheckList = mapSecond (Left . RmHLS)
[ -- failed with ("rm hls", xxx)
("rm hls 2.0", $(versionQ "2.0"))
, ("rm hls hls-2.0", $(versionQ "hls-2.0"))
("rm hls 2.0", mkVersion $ (Digits 2 :| []) :| [Digits 0 :| []])
, ("rm hls hls-2.0", Version
{ _vEpoch = Nothing
, _vChunks = (Str "hls" :| []) :| []
, _vRel = [Digits 2 :| [], Digits 0 :| []]
, _vMeta = Nothing
}
)
]
rmStackCheckList :: [(String, Either RmCommand RmOptions)]
rmStackCheckList = mapSecond (Left . RmStack)
[ -- failed with ("rm stack", xxx)
("rm stack 2.9.1", $(versionQ "2.9.1"))
, ("rm stack stack-2.9.1", $(versionQ "stack-2.9.1"))
("rm stack 2.9.1", mkVersion $ (Digits 2 :| []) :| [Digits 9 :| [], Digits 1 :| []])
, ("rm stack stack-2.9.1", Version
{ _vEpoch = Nothing
, _vChunks = (Str "stack" :| []) :| []
, _vRel = [Digits 2 :| [], Digits 9 :| [], Digits 1 :| []]
, _vMeta = Nothing
}
)
]
rmParseWith :: [String] -> IO (Either RmCommand RmOptions)

View File

@@ -1,6 +1,5 @@
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE TemplateHaskell #-}
module RunTest where
@@ -8,7 +7,6 @@ import Test.Tasty
import GHCup.OptParse
import Utils
import GHCup.Types
import Data.Versions (versionQ)
runTests :: TestTree
@@ -37,11 +35,11 @@ runCheckList =
, ("run --install", defaultOptions{runInstTool' = True})
, ("run -m", defaultOptions{runMinGWPath = True})
, ("run --mingw-path", defaultOptions{runMinGWPath = True})
, ("run --ghc 9.2.8", defaultOptions{runGHCVer = Just $ GHCVersion $ mkTVer $(versionQ "9.2.8")})
, ("run --ghc 9.2.8", defaultOptions{runGHCVer = Just $ GHCVersion $ mkTVer $ mkVersion' "9.2.8"})
, ("run --ghc latest", defaultOptions{runGHCVer = Just $ ToolTag Latest})
, ("run --cabal 3.10", defaultOptions{runCabalVer = Just $ ToolVersion $(versionQ "3.10")})
, ("run --hls 2.0", defaultOptions{runHLSVer = Just $ ToolVersion $(versionQ "2.0")})
, ("run --stack 2.9", defaultOptions{runStackVer = Just $ ToolVersion $(versionQ "2.9") })
, ("run --cabal 3.10", defaultOptions{runCabalVer = Just $ ToolVersion $ mkVersion' "3.10"})
, ("run --hls 2.0", defaultOptions{runHLSVer = Just $ ToolVersion $ mkVersion' "2.0"})
, ("run --stack 2.9", defaultOptions{runStackVer = Just $ ToolVersion $ mkVersion' "2.9"})
#ifdef IS_WINDOWS
, ("run -b C:\\\\tmp\\dir", defaultOptions{runBinDir = Just "C:\\\\tmp\\dir"})
, ("run --bindir C:\\\\tmp\\dir", defaultOptions{runBinDir = Just "C:\\\\tmp\\dir"})
@@ -54,9 +52,9 @@ runCheckList =
, ("run --ghc latest --cabal 3.10 --stack 2.9 --hls 2.0 --install",
defaultOptions
{ runGHCVer = Just $ ToolTag Latest
, runCabalVer = Just $ ToolVersion $(versionQ "3.10")
, runHLSVer = Just $ ToolVersion $(versionQ "2.0")
, runStackVer = Just $ ToolVersion $(versionQ "2.9")
, runCabalVer = Just $ ToolVersion $ mkVersion' "3.10"
, runHLSVer = Just $ ToolVersion $ mkVersion' "2.0"
, runStackVer = Just $ ToolVersion $ mkVersion' "2.9"
, runInstTool' = True
}
)

View File

@@ -1,5 +1,4 @@
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
module SetTest where
@@ -28,44 +27,44 @@ oldStyleCheckList = mapSecond (Right . SetOptions)
, ("set ghc-9.2", SetGHCVersion
$ GHCTargetVersion
(Just "ghc")
$(versionQ "9.2")
(mkVersion $ (Digits 9 :| []) :| [Digits 2 :| []])
)
, ("set next", SetNext)
, ("set latest", SetToolTag Latest)
, ("set nightly", SetGHCVersion
$ GHCTargetVersion
Nothing
$(versionQ "nightly")
(mkVersion $ (Str "nightly" :| []) :| [])
)
-- different from `set`
, ("set recommended", SetToolTag Recommended)
, ("set prerelease", SetGHCVersion
$ GHCTargetVersion
Nothing
$(versionQ "prerelease")
(mkVersion $ (Str "prerelease" :| []) :| [])
)
, ("set latest-prerelease", SetToolTag LatestPrerelease)
, ("set latest-nightly", SetToolTag LatestNightly)
, ("set ghc-javascript-unknown-ghcjs-9.6", SetGHCVersion
$ GHCTargetVersion
(Just "ghc-javascript-unknown-ghcjs")
$(versionQ "9.6")
(mkVersion $ (Digits 9 :| []) :| [Digits 6 :| []])
)
, ("set base-4.18", SetToolTag (Base (PVP {_pComponents = 4 :| [18]})))
, ("set cabal-3.10", SetGHCVersion
$ GHCTargetVersion
(Just "cabal")
$(versionQ "3.10")
(mkVersion $ (Digits 3 :| []) :| [Digits 10 :| []])
)
, ("set hls-2.0.0.0", SetGHCVersion
$ GHCTargetVersion
(Just "hls")
$(versionQ "2.0.0.0")
(mkVersion $ (Digits 2 :| []) :| [Digits 0 :| [], Digits 0 :| [], Digits 0 :| []])
)
, ("set stack-2.9.3", SetGHCVersion
$ GHCTargetVersion
(Just "stack")
$(versionQ "2.9.3")
(mkVersion $ (Digits 2 :| []) :| [Digits 9 :| [], Digits 3 :| []])
)
]
@@ -75,79 +74,100 @@ setGhcCheckList = mapSecond (Left . SetGHC . SetOptions)
, ("set ghc 9.2", SetGHCVersion
$ GHCTargetVersion
Nothing
$(versionQ "9.2")
(mkVersion $ (Digits 9 :| []) :| [Digits 2 :| []])
)
, ("set ghc next", SetNext)
, ("set ghc latest", SetToolTag Latest)
, ("set ghc nightly", SetGHCVersion
$ GHCTargetVersion
Nothing
$(versionQ "nightly")
(mkVersion $ (Str "nightly" :| []) :| [])
)
, ("set ghc recommended", SetToolTag Recommended)
, ("set ghc prerelease", SetGHCVersion
$ GHCTargetVersion
Nothing
$(versionQ "prerelease")
(mkVersion $ (Str "prerelease" :| []) :| [])
)
, ("set ghc latest-prerelease", SetToolTag LatestPrerelease)
, ("set ghc latest-nightly", SetToolTag LatestNightly)
, ("set ghc javascript-unknown-ghcjs-9.6", SetGHCVersion
$ GHCTargetVersion
(Just "javascript-unknown-ghcjs")
$(versionQ "9.6")
(mkVersion $ (Digits 9 :| []) :| [Digits 6 :| []])
)
, ("set ghc base-4.18", SetToolTag (Base (PVP {_pComponents = 4 :| [18]})))
, ("set ghc ghc-9.2", SetGHCVersion
$ GHCTargetVersion
(Just "ghc")
$(versionQ "9.2")
(mkVersion $ (Digits 9 :| []) :| [Digits 2 :| []])
)
]
setCabalCheckList :: [(String, Either SetCommand SetOptions)]
setCabalCheckList = mapSecond (Left . SetCabal . SetOptions)
[ ("set cabal", SetRecommended)
, ("set cabal 3.10", SetToolVersion $(versionQ "3.10"))
, ("set cabal 3.10", SetToolVersion $ mkVersion $ (Digits 3 :| []) :| [Digits 10 :| []])
, ("set cabal next", SetNext)
, ("set cabal latest", SetToolTag Latest)
, ("set cabal nightly", SetToolVersion $(versionQ "nightly"))
, ("set cabal nightly", SetToolVersion $ mkVersion $ (Str "nightly" :| []) :| [])
, ("set cabal recommended", SetToolTag Recommended)
, ("set cabal prerelease", SetToolVersion $(versionQ "prerelease"))
, ("set cabal prerelease", SetToolVersion $ mkVersion $ (Str "prerelease" :| []) :| [])
, ("set cabal latest-prerelease", SetToolTag LatestPrerelease)
, ("set cabal latest-nightly", SetToolTag LatestNightly)
, ("set cabal base-4.18", SetToolTag (Base (PVP {_pComponents = 4 :| [18]})))
, ("set cabal cabal-3.10", SetToolVersion $(versionQ "cabal-3.10"))
, ("set cabal cabal-3.10", SetToolVersion
$ Version
{ _vEpoch = Nothing
, _vChunks = (Str "cabal" :| []) :| []
, _vRel = [Digits 3 :| [], Digits 10 :| []]
, _vMeta = Nothing
}
)
]
setHlsCheckList :: [(String, Either SetCommand SetOptions)]
setHlsCheckList = mapSecond (Left . SetHLS . SetOptions)
[ ("set hls", SetRecommended)
, ("set hls 2.0", SetToolVersion $(versionQ "2.0"))
, ("set hls 2.0", SetToolVersion $ mkVersion $ (Digits 2 :| []) :| [Digits 0 :| []])
, ("set hls next", SetNext)
, ("set hls latest", SetToolTag Latest)
, ("set hls nightly", SetToolVersion $(versionQ "nightly"))
, ("set hls nightly", SetToolVersion $ mkVersion $ (Str "nightly" :| []) :| [])
, ("set hls recommended", SetToolTag Recommended)
, ("set hls prerelease", SetToolVersion $(versionQ "prerelease"))
, ("set hls prerelease", SetToolVersion $ mkVersion $ (Str "prerelease" :| []) :| [])
, ("set hls latest-prerelease", SetToolTag LatestPrerelease)
, ("set hls latest-nightly", SetToolTag LatestNightly)
, ("set hls base-4.18", SetToolTag (Base (PVP {_pComponents = 4 :| [18]})))
, ("set hls hls-2.0", SetToolVersion $(versionQ "hls-2.0"))
, ("set hls hls-2.0", SetToolVersion
$ Version
{ _vEpoch = Nothing
, _vChunks = (Str "hls" :| []) :| []
, _vRel = [Digits 2 :| [], Digits 0 :| []]
, _vMeta = Nothing
}
)
]
setStackCheckList :: [(String, Either SetCommand SetOptions)]
setStackCheckList = mapSecond (Left . SetStack . SetOptions)
[ ("set stack", SetRecommended)
, ("set stack 2.9", SetToolVersion $(versionQ "2.9"))
, ("set stack 2.9", SetToolVersion $ mkVersion $ (Digits 2 :| []) :| [Digits 9 :| []])
, ("set stack next", SetNext)
, ("set stack latest", SetToolTag Latest)
, ("set stack nightly", SetToolVersion $(versionQ "nightly"))
, ("set stack nightly", SetToolVersion $ mkVersion $ (Str "nightly" :| []) :| [])
, ("set stack recommended", SetToolTag Recommended)
, ("set stack prerelease", SetToolVersion $(versionQ "prerelease"))
, ("set stack prerelease", SetToolVersion $ mkVersion $ (Str "prerelease" :| []) :| [])
, ("set stack latest-prerelease", SetToolTag LatestPrerelease)
, ("set stack latest-nightly", SetToolTag LatestNightly)
, ("set stack base-4.18", SetToolTag (Base (PVP {_pComponents = 4 :| [18]})))
, ("set stack stack-2.9", SetToolVersion $(versionQ "stack-2.9"))
, ("set stack stack-2.9", SetToolVersion
$ Version
{ _vEpoch = Nothing
, _vChunks = (Str "stack" :| []) :| []
, _vRel = [Digits 2 :| [], Digits 9 :| []]
, _vMeta = Nothing
}
)
]
setParseWith :: [String] -> IO (Either SetCommand SetOptions)

View File

@@ -4,9 +4,12 @@ module Utils where
import GHCup.OptParse as GHCup
import Options.Applicative
import Data.Bifunctor
import Data.Versions
import Data.List.NonEmpty (NonEmpty)
import Test.Tasty
import Test.Tasty.HUnit
import Control.Monad.IO.Class
import qualified Data.Text as T
parseWith :: [String] -> IO Command
parseWith args =
@@ -20,6 +23,14 @@ padLeft desiredLength s = padding ++ s
mapSecond :: (b -> c) -> [(a,b)] -> [(a,c)]
mapSecond = map . second
mkVersion :: NonEmpty VChunk -> Version
mkVersion chunks = Version Nothing chunks [] Nothing
mkVersion' :: T.Text -> Version
mkVersion' txt =
let Right ver = version txt
in ver
buildTestTree
:: (Eq a, Show a)
=> ([String] -> IO a) -- ^ The parse function

View File

@@ -1,5 +1,4 @@
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
module WhereisTest where
@@ -7,7 +6,6 @@ import Test.Tasty
import GHCup.OptParse
import Utils
import GHCup.Types
import Data.Versions (versionQ)
whereisTests :: TestTree
whereisTests = buildTestTree whereisParseWith ("whereis", whereisCheckList)
@@ -15,8 +13,8 @@ whereisTests = buildTestTree whereisParseWith ("whereis", whereisCheckList)
whereisCheckList :: [(String, (WhereisOptions, WhereisCommand))]
whereisCheckList = concatMap mk
[ ("whereis ghc", WhereisTool GHC Nothing)
, ("whereis ghc 9.2.8", WhereisTool GHC (Just $ GHCVersion $ mkTVer $(versionQ "9.2.8")))
, ("whereis ghc ghc-9.2.8", WhereisTool GHC (Just $ GHCVersion $ GHCTargetVersion (Just "ghc") $(versionQ "9.2.8")))
, ("whereis ghc 9.2.8", WhereisTool GHC (Just $ GHCVersion $ mkTVer $ mkVersion' "9.2.8"))
, ("whereis ghc ghc-9.2.8", WhereisTool GHC (Just $ GHCVersion $ GHCTargetVersion (Just "ghc") (mkVersion' "9.2.8")))
, ("whereis ghc latest", WhereisTool GHC (Just $ ToolTag Latest))
, ("whereis cabal", WhereisTool Cabal Nothing)
, ("whereis hls", WhereisTool HLS Nothing)