Compare commits
1 Commits
issue-892
...
issues/880
| Author | SHA1 | Date | |
|---|---|---|---|
| 4b7d165b57 |
44
.github/scripts/test.sh
vendored
44
.github/scripts/test.sh
vendored
@@ -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
2
.gitmodules
vendored
@@ -1,4 +1,4 @@
|
||||
[submodule "data/metadata"]
|
||||
path = data/metadata
|
||||
url = https://github.com/haskell/ghcup-metadata.git
|
||||
branch = develop
|
||||
branch = master
|
||||
|
||||
@@ -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 ())
|
||||
|
||||
@@ -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)
|
||||
@@ -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
|
||||
@@ -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
|
||||
@@ -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
|
||||
@@ -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 )
|
||||
@@ -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 )
|
||||
@@ -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
|
||||
@@ -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 )
|
||||
@@ -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)
|
||||
|
||||
|
||||
|
||||
@@ -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 }))
|
||||
|
||||
@@ -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
|
||||
@@ -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
|
||||
|
||||
@@ -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:
|
||||
#
|
||||
|
||||
Submodule data/metadata updated: 2efadd4588...c88802ea8c
135
docs/guide.md
135
docs/guide.md
@@ -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:
|
||||
|
||||
@@ -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:
|
||||
|
||||
|
||||
49
ghcup.cabal
49
ghcup.cabal
@@ -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
|
||||
|
||||
@@ -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.
|
||||
|
||||
@@ -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."
|
||||
|
||||
|
||||
------------------------
|
||||
|
||||
@@ -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
|
||||
|
||||
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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'
|
||||
|
||||
|
||||
@@ -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 #-}
|
||||
|
||||
|
||||
@@ -11,7 +11,6 @@ Portability : portable
|
||||
-}
|
||||
module GHCup.Prelude.Process (
|
||||
executeOut,
|
||||
executeOut',
|
||||
execLogged,
|
||||
exec,
|
||||
toProcessError,
|
||||
|
||||
@@ -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"
|
||||
|
||||
|
||||
@@ -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
|
||||
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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)
|
||||
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
@@ -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
|
||||
}
|
||||
|
||||
@@ -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
|
||||
|
||||
|
||||
-----------
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
@@ -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"))))
|
||||
]
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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)
|
||||
|
||||
@@ -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
|
||||
}
|
||||
)
|
||||
|
||||
@@ -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)
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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)
|
||||
|
||||
Reference in New Issue
Block a user