Merge branch 'nightlies'

This commit is contained in:
Julian Ospald 2023-06-29 18:27:17 +08:00
commit 3e83a7fd83
No known key found for this signature in database
GPG Key ID: CCC85C0E40C06A8C
31 changed files with 14634 additions and 10647 deletions

View File

@ -1,5 +1,5 @@
freebsd_instance: freebsd_instance:
image_family: freebsd-13-1 image_family: freebsd-13-2
build_task: build_task:
name: build name: build
@ -16,7 +16,9 @@ build_task:
AWS_ACCESS_KEY_ID: ENCRYPTED[6ed6287e2dd78ab5f84b22232c5245834ab042bd8ba443883aaf4b4d1ecc0481add1fdfad5ae6f6a8cfb418e6f19b2fc] AWS_ACCESS_KEY_ID: ENCRYPTED[6ed6287e2dd78ab5f84b22232c5245834ab042bd8ba443883aaf4b4d1ecc0481add1fdfad5ae6f6a8cfb418e6f19b2fc]
AWS_SECRET_ACCESS_KEY: ENCRYPTED[16f3cda2954c7cee99444e6788eb5997382aa4ce1477e7523fef2586077541f43b5c816156961fc6b4677259679875a7] AWS_SECRET_ACCESS_KEY: ENCRYPTED[16f3cda2954c7cee99444e6788eb5997382aa4ce1477e7523fef2586077541f43b5c816156961fc6b4677259679875a7]
S3_HOST: ENCRYPTED[ce961780a33159f7d1d8046956b5ac6ebc3bfc8149428e5f538576cda51d9f3d0c35b79cdd1e325793639ff6e31f889d] S3_HOST: ENCRYPTED[ce961780a33159f7d1d8046956b5ac6ebc3bfc8149428e5f538576cda51d9f3d0c35b79cdd1e325793639ff6e31f889d]
install_script: pkg install -y ghc hs-cabal-install git bash misc/compat10x misc/compat11x misc/compat12x gmake llvm14 install_script:
- sed -i.bak -e 's/quarterly/latest/' /etc/pkg/FreeBSD.conf
- pkg install -y ghc hs-cabal-install git bash misc/compat10x misc/compat11x misc/compat12x gmake llvm14
script: script:
- tzsetup Etc/GMT - tzsetup Etc/GMT
- adjkerntz -a - adjkerntz -a

View File

@ -25,7 +25,7 @@ jobs:
include: include:
- os: ubuntu-latest - os: ubuntu-latest
DISTRO: Ubuntu DISTRO: Ubuntu
- os: macOS-10.15 - os: macOS-11
DISTRO: na DISTRO: na
- os: windows-latest - os: windows-latest
DISTRO: na DISTRO: na

View File

@ -81,7 +81,7 @@ jobs:
name: Build ARM binary name: Build ARM binary
runs-on: ${{ matrix.os }} runs-on: ${{ matrix.os }}
env: env:
CABAL_VER: 3.8.1.0 CABAL_VER: 3.6.2.0
JSON_VERSION: "0.0.7" JSON_VERSION: "0.0.7"
AWS_SECRET_ACCESS_KEY: ${{ secrets.AWS_SECRET_ACCESS_KEY }} AWS_SECRET_ACCESS_KEY: ${{ secrets.AWS_SECRET_ACCESS_KEY }}
AWS_ACCESS_KEY_ID: ${{ secrets.AWS_ACCESS_KEY_ID }} AWS_ACCESS_KEY_ID: ${{ secrets.AWS_ACCESS_KEY_ID }}
@ -90,7 +90,7 @@ jobs:
fail-fast: true fail-fast: true
matrix: matrix:
include: include:
- os: [self-hosted, Linux, ARM64, aarch32-linux] - os: [self-hosted, Linux, ARM64]
ARTIFACT: "armv7-linux-ghcup" ARTIFACT: "armv7-linux-ghcup"
GHC_VER: 9.2.2 GHC_VER: 9.2.2
ARCH: ARM ARCH: ARM
@ -168,7 +168,7 @@ jobs:
ARTIFACT: "aarch64-apple-darwin-ghcup" ARTIFACT: "aarch64-apple-darwin-ghcup"
GHC_VER: 9.2.6 GHC_VER: 9.2.6
ARCH: ARM64 ARCH: ARM64
- os: macOS-10.15 - os: macOS-11
ARTIFACT: "x86_64-apple-darwin-ghcup" ARTIFACT: "x86_64-apple-darwin-ghcup"
GHC_VER: 9.2.6 GHC_VER: 9.2.6
ARCH: 64 ARCH: 64
@ -325,12 +325,12 @@ jobs:
needs: "build-arm" needs: "build-arm"
runs-on: ${{ matrix.os }} runs-on: ${{ matrix.os }}
env: env:
CABAL_VER: 3.8.1.0 CABAL_VER: 3.6.2.0
JSON_VERSION: "0.0.7" JSON_VERSION: "0.0.7"
strategy: strategy:
matrix: matrix:
include: include:
- os: [self-hosted, Linux, ARM64, aarch32-linux] - os: [self-hosted, Linux, ARM64]
ARTIFACT: "armv7-linux-ghcup" ARTIFACT: "armv7-linux-ghcup"
GHC_VER: 9.2.2 GHC_VER: 9.2.2
ARCH: ARM ARCH: ARM
@ -403,7 +403,7 @@ jobs:
GHC_VER: 9.2.6 GHC_VER: 9.2.6
ARCH: ARM64 ARCH: ARM64
DISTRO: na DISTRO: na
- os: macOS-10.15 - os: macOS-11
ARTIFACT: "x86_64-apple-darwin-ghcup" ARTIFACT: "x86_64-apple-darwin-ghcup"
GHC_VER: 9.2.6 GHC_VER: 9.2.6
ARCH: 64 ARCH: 64

View File

@ -73,8 +73,8 @@ data BrickData = BrickData
deriving Show deriving Show
data BrickSettings = BrickSettings data BrickSettings = BrickSettings
{ showAllVersions :: Bool { showAllVersions :: Bool
, showAllTools :: Bool , showAllTools :: Bool
} }
deriving Show deriving Show
@ -202,9 +202,11 @@ ui dimAttrs BrickState{ appSettings = as@BrickSettings{}, ..}
printTag Recommended = Just $ withAttr (attrName "recommended") $ str "recommended" printTag Recommended = Just $ withAttr (attrName "recommended") $ str "recommended"
printTag Latest = Just $ withAttr (attrName "latest") $ str "latest" printTag Latest = Just $ withAttr (attrName "latest") $ str "latest"
printTag Prerelease = Just $ withAttr (attrName "prerelease") $ str "prerelease" printTag Prerelease = Just $ withAttr (attrName "prerelease") $ str "prerelease"
printTag Nightly = Just $ withAttr (attrName "nightly") $ str "nightly"
printTag (Base pvp'') = Just $ str ("base-" ++ T.unpack (prettyPVP pvp'')) printTag (Base pvp'') = Just $ str ("base-" ++ T.unpack (prettyPVP pvp''))
printTag Old = Nothing printTag Old = Nothing
printTag LatestPrerelease = Just $ withAttr (attrName "latest-prerelease") $ str "latest-prerelease" printTag LatestPrerelease = Just $ withAttr (attrName "latest-prerelease") $ str "latest-prerelease"
printTag LatestNightly = Just $ withAttr (attrName "latest-nightly") $ str "latest-nightly"
printTag (UnknownTag t) = Just $ str t printTag (UnknownTag t) = Just $ str t
printTool Cabal = str "cabal" printTool Cabal = str "cabal"
@ -218,6 +220,9 @@ ui dimAttrs BrickState{ appSettings = as@BrickSettings{}, ..}
) )
++ (if fromSrc then [withAttr (attrName "compiled") $ str "compiled"] else mempty) ++ (if fromSrc then [withAttr (attrName "compiled") $ str "compiled"] else mempty)
++ (if lStray then [withAttr (attrName "stray") $ str "stray"] else mempty) ++ (if lStray then [withAttr (attrName "stray") $ str "stray"] else mempty)
++ (case lReleaseDay of
Nothing -> mempty
Just d -> [withAttr (attrName "day") $ str (show d)])
-- | Draws the list elements. -- | Draws the list elements.
-- --
@ -272,19 +277,22 @@ app attrs dimAttrs =
defaultAttributes :: Bool -> AttrMap defaultAttributes :: Bool -> AttrMap
defaultAttributes no_color = attrMap defaultAttributes no_color = attrMap
Vty.defAttr Vty.defAttr
[ (attrName "active" , Vty.defAttr `withBackColor` Vty.blue) [ (attrName "active" , Vty.defAttr `withBackColor` Vty.blue)
, (attrName "not-installed", Vty.defAttr `withForeColor` Vty.red) , (attrName "not-installed" , Vty.defAttr `withForeColor` Vty.red)
, (attrName "set" , Vty.defAttr `withForeColor` Vty.green) , (attrName "set" , Vty.defAttr `withForeColor` Vty.green)
, (attrName "installed" , Vty.defAttr `withForeColor` Vty.green) , (attrName "installed" , Vty.defAttr `withForeColor` Vty.green)
, (attrName "recommended" , Vty.defAttr `withForeColor` Vty.green) , (attrName "recommended" , Vty.defAttr `withForeColor` Vty.green)
, (attrName "hls-powered" , Vty.defAttr `withForeColor` Vty.green) , (attrName "hls-powered" , Vty.defAttr `withForeColor` Vty.green)
, (attrName "latest" , Vty.defAttr `withForeColor` Vty.yellow) , (attrName "latest" , Vty.defAttr `withForeColor` Vty.yellow)
, (attrName "latest-prerelease" , Vty.defAttr `withForeColor` Vty.red) , (attrName "latest-prerelease" , Vty.defAttr `withForeColor` Vty.red)
, (attrName "prerelease" , Vty.defAttr `withForeColor` Vty.red) , (attrName "latest-nightly" , Vty.defAttr `withForeColor` Vty.red)
, (attrName "compiled" , Vty.defAttr `withForeColor` Vty.blue) , (attrName "prerelease" , Vty.defAttr `withForeColor` Vty.red)
, (attrName "stray" , Vty.defAttr `withForeColor` Vty.blue) , (attrName "nightly" , Vty.defAttr `withForeColor` Vty.red)
, (attrName "help" , Vty.defAttr `withStyle` Vty.italic) , (attrName "compiled" , Vty.defAttr `withForeColor` Vty.blue)
, (attrName "hooray" , Vty.defAttr `withForeColor` Vty.brightWhite) , (attrName "stray" , Vty.defAttr `withForeColor` Vty.blue)
, (attrName "day" , Vty.defAttr `withForeColor` Vty.blue)
, (attrName "help" , Vty.defAttr `withStyle` Vty.italic)
, (attrName "hooray" , Vty.defAttr `withForeColor` Vty.brightWhite)
] ]
where where
withForeColor | no_color = const withForeColor | no_color = const
@ -411,13 +419,17 @@ filterVisible :: Bool -> Bool -> ListResult -> Bool
filterVisible v t e | lInstalled e = True filterVisible v t e | lInstalled e = True
| v | v
, not t , not t
, Nightly `notElem` lTag e
, lTool e `notElem` hiddenTools = True , lTool e `notElem` hiddenTools = True
| not v | not v
, t , t
, Old `notElem` lTag e = True , Old `notElem` lTag e
, Nightly `notElem` lTag e = True
| v | v
, Nightly `notElem` lTag e
, t = True , t = True
| otherwise = (Old `notElem` lTag e) && | otherwise = (Old `notElem` lTag e) &&
(Nightly `notElem` lTag e) &&
(lTool e `notElem` hiddenTools) (lTool e `notElem` hiddenTools)
@ -576,7 +588,7 @@ changelog' :: (MonadReader AppState m, MonadIO m)
-> m (Either String ()) -> m (Either String ())
changelog' _ (_, ListResult {..}) = do changelog' _ (_, ListResult {..}) = do
AppState { pfreq, ghcupInfo = GHCupInfo { _ghcupDownloads = dls }} <- ask AppState { pfreq, ghcupInfo = GHCupInfo { _ghcupDownloads = dls }} <- ask
case getChangeLog dls lTool (Left lVer) of case getChangeLog dls lTool (ToolVersion lVer) of
Nothing -> pure $ Left $ Nothing -> pure $ Left $
"Could not find ChangeLog for " <> prettyShow lTool <> ", version " <> T.unpack (prettyVer lVer) "Could not find ChangeLog for " <> prettyShow lTool <> ", version " <> T.unpack (prettyVer lVer)
Just uri -> do Just uri -> do
@ -656,5 +668,5 @@ getAppData mgi = runExceptT $ do
settings <- liftIO $ readIORef settings' settings <- liftIO $ readIORef settings'
flip runReaderT settings $ do flip runReaderT settings $ do
lV <- listVersions Nothing Nothing lV <- listVersions Nothing [] False True (Nothing, Nothing)
pure $ BrickData (reverse lV) pure $ BrickData (reverse lV)

View File

@ -244,7 +244,8 @@ com =
<> command <> command
"list" "list"
(info (List <$> listOpts <**> helper) (info (List <$> listOpts <**> helper)
(progDesc "Show available GHCs and other tools") (progDesc "Show available GHCs and other tools"
<> footerDoc (Just $ text listToolFooter))
) )
<> command <> command
"upgrade" "upgrade"

View File

@ -35,7 +35,6 @@ import qualified Data.Text as T
import Control.Exception.Safe (MonadMask) import Control.Exception.Safe (MonadMask)
import GHCup.Types.Optics import GHCup.Types.Optics
import GHCup.Utils import GHCup.Utils
import Data.Versions
import URI.ByteString (serializeURIRef') import URI.ByteString (serializeURIRef')
import Data.Char (toLower) import Data.Char (toLower)
@ -81,7 +80,7 @@ changelogP =
<> completer toolCompleter <> completer toolCompleter
) )
) )
<*> optional (toolVersionTagArgument Nothing Nothing) <*> optional (toolVersionTagArgument [] Nothing)
@ -115,20 +114,15 @@ changelog :: ( Monad m
changelog ChangeLogOptions{..} runAppState runLogger = do changelog ChangeLogOptions{..} runAppState runLogger = do
GHCupInfo { _ghcupDownloads = dls } <- runAppState getGHCupInfo GHCupInfo { _ghcupDownloads = dls } <- runAppState getGHCupInfo
let tool = fromMaybe GHC clTool let tool = fromMaybe GHC clTool
ver' = maybe ver' = fromMaybe
(Right Latest) (ToolTag Latest)
(\case
GHCVersion tv -> Left (_tvVersion tv)
ToolVersion tv -> Left tv
ToolTag t -> Right t
)
clToolVer clToolVer
muri = getChangeLog dls tool ver' muri = getChangeLog dls tool ver'
case muri of case muri of
Nothing -> do Nothing -> do
runLogger runLogger
(logWarn $ (logWarn $
"Could not find ChangeLog for " <> T.pack (prettyShow tool) <> ", version " <> either prettyVer (T.pack . show) ver' "Could not find ChangeLog for " <> T.pack (prettyShow tool) <> ", version " <> T.pack (prettyShow ver')
) )
pure ExitSuccess pure ExitSuccess
Just uri -> do Just uri -> do

View File

@ -45,6 +45,8 @@ import Data.Functor
import Data.List ( nub, sort, sortBy, isPrefixOf, stripPrefix ) import Data.List ( nub, sort, sortBy, isPrefixOf, stripPrefix )
import Data.Maybe import Data.Maybe
import Data.Text ( Text ) import Data.Text ( Text )
import Data.Time.Calendar ( Day )
import Data.Time.Format ( parseTimeM, defaultTimeLocale )
import Data.Versions hiding ( str ) import Data.Versions hiding ( str )
import Data.Void import Data.Void
import qualified Data.Vector as V import qualified Data.Vector as V
@ -72,26 +74,26 @@ import qualified Cabal.Config as CC
--[ Types ]-- --[ Types ]--
------------- -------------
data ToolVersion = GHCVersion GHCTargetVersion
| ToolVersion Version
| ToolTag Tag
-- a superset of ToolVersion -- a superset of ToolVersion
data SetToolVersion = SetGHCVersion GHCTargetVersion data SetToolVersion = SetGHCVersion GHCTargetVersion
| SetToolVersion Version | SetToolVersion Version
| SetToolTag Tag | SetToolTag Tag
| SetToolDay Day
| SetRecommended | SetRecommended
| SetNext | SetNext
prettyToolVer :: ToolVersion -> String prettyToolVer :: ToolVersion -> String
prettyToolVer (GHCVersion v') = T.unpack $ tVerToText v' prettyToolVer (GHCVersion v') = T.unpack $ tVerToText v'
prettyToolVer (ToolVersion v') = T.unpack $ prettyVer v' prettyToolVer (ToolVersion v') = T.unpack $ prettyVer v'
prettyToolVer (ToolTag t) = show t prettyToolVer (ToolTag t) = show t
prettyToolVer (ToolDay day) = show day
toSetToolVer :: Maybe ToolVersion -> SetToolVersion toSetToolVer :: Maybe ToolVersion -> SetToolVersion
toSetToolVer (Just (GHCVersion v')) = SetGHCVersion v' toSetToolVer (Just (GHCVersion v')) = SetGHCVersion v'
toSetToolVer (Just (ToolVersion v')) = SetToolVersion v' toSetToolVer (Just (ToolVersion v')) = SetToolVersion v'
toSetToolVer (Just (ToolTag t')) = SetToolTag t' toSetToolVer (Just (ToolTag t')) = SetToolTag t'
toSetToolVer (Just (ToolDay d')) = SetToolDay d'
toSetToolVer Nothing = SetRecommended toSetToolVer Nothing = SetRecommended
@ -102,28 +104,28 @@ toSetToolVer Nothing = SetRecommended
-------------- --------------
toolVersionTagArgument :: Maybe ListCriteria -> Maybe Tool -> Parser ToolVersion toolVersionTagArgument :: [ListCriteria] -> Maybe Tool -> Parser ToolVersion
toolVersionTagArgument criteria tool = toolVersionTagArgument criteria tool =
argument (eitherReader (parser tool)) argument (eitherReader (parser tool))
(metavar (mv tool) (metavar (mv tool)
<> completer (tagCompleter (fromMaybe GHC tool) []) <> completer (tagCompleter (fromMaybe GHC tool) [])
<> foldMap (completer . versionCompleter criteria) tool) <> foldMap (completer . versionCompleter criteria) tool)
where where
mv (Just GHC) = "GHC_VERSION|TAG" mv (Just GHC) = "GHC_VERSION|TAG|RELEASE_DATE"
mv (Just HLS) = "HLS_VERSION|TAG" mv (Just HLS) = "HLS_VERSION|TAG|RELEASE_DATE"
mv _ = "VERSION|TAG" mv _ = "VERSION|TAG|RELEASE_DATE"
parser (Just GHC) = ghcVersionTagEither parser (Just GHC) = ghcVersionTagEither
parser Nothing = ghcVersionTagEither parser Nothing = ghcVersionTagEither
parser _ = toolVersionTagEither parser _ = toolVersionTagEither
versionParser' :: Maybe ListCriteria -> Maybe Tool -> Parser Version versionParser' :: [ListCriteria] -> Maybe Tool -> Parser Version
versionParser' criteria tool = argument versionParser' criteria tool = argument
(eitherReader (first show . version . T.pack)) (eitherReader (first show . version . T.pack))
(metavar "VERSION" <> foldMap (completer . versionCompleter criteria) tool) (metavar "VERSION" <> foldMap (completer . versionCompleter criteria) tool)
ghcVersionArgument :: Maybe ListCriteria -> Maybe Tool -> Parser GHCTargetVersion ghcVersionArgument :: [ListCriteria] -> Maybe Tool -> Parser GHCTargetVersion
ghcVersionArgument criteria tool = argument (eitherReader ghcVersionEither) ghcVersionArgument criteria tool = argument (eitherReader ghcVersionEither)
(metavar "VERSION" <> foldMap (completer . versionCompleter criteria) tool) (metavar "VERSION" <> foldMap (completer . versionCompleter criteria) tool)
@ -237,22 +239,23 @@ isolateParser f = case isValid f && isAbsolute f of
-- this accepts cross prefix -- this accepts cross prefix
ghcVersionTagEither :: String -> Either String ToolVersion ghcVersionTagEither :: String -> Either String ToolVersion
ghcVersionTagEither s' = ghcVersionTagEither s' =
second ToolTag (tagEither s') <|> second GHCVersion (ghcVersionEither s') second ToolDay (dayParser s') <|> second ToolTag (tagEither s') <|> second GHCVersion (ghcVersionEither s')
-- this ignores cross prefix -- this ignores cross prefix
toolVersionTagEither :: String -> Either String ToolVersion toolVersionTagEither :: String -> Either String ToolVersion
toolVersionTagEither s' = toolVersionTagEither s' =
second ToolTag (tagEither s') <|> second ToolVersion (toolVersionEither s') second ToolDay (dayParser s') <|> second ToolTag (tagEither s') <|> second ToolVersion (toolVersionEither s')
tagEither :: String -> Either String Tag tagEither :: String -> Either String Tag
tagEither s' = case fmap toLower s' of tagEither s' = case fmap toLower s' of
"recommended" -> Right Recommended "recommended" -> Right Recommended
"latest" -> Right Latest "latest" -> Right Latest
"latest-prerelease" -> Right LatestPrerelease "latest-prerelease" -> Right LatestPrerelease
"latest-nightly" -> Right LatestNightly
('b':'a':'s':'e':'-':ver') -> case pvp (T.pack ver') of ('b':'a':'s':'e':'-':ver') -> case pvp (T.pack ver') of
Right x -> Right (Base x) Right x -> Right (Base x)
Left _ -> Left $ "Invalid PVP version for base " <> ver' Left _ -> Left $ "Invalid PVP version for base " <> ver'
other -> Left $ "Unknown tag " <> other other -> Left $ "Unknown tag " <> other
ghcVersionEither :: String -> Either String GHCTargetVersion ghcVersionEither :: String -> Either String GHCTargetVersion
@ -261,7 +264,7 @@ ghcVersionEither =
toolVersionEither :: String -> Either String Version toolVersionEither :: String -> Either String Version
toolVersionEither = toolVersionEither =
first (const "Not a valid version") . MP.parse version' "" . T.pack first (const "Not a valid version") . MP.parse (version' <* MP.eof) "" . T.pack
toolParser :: String -> Either String Tool toolParser :: String -> Either String Tool
@ -272,12 +275,22 @@ toolParser s' | t == T.pack "ghc" = Right GHC
| otherwise = Left ("Unknown tool: " <> s') | otherwise = Left ("Unknown tool: " <> s')
where t = T.toLower (T.pack s') where t = T.toLower (T.pack s')
dayParser :: String -> Either String Day
dayParser s = maybe (Left $ "Could not parse \"" <> s <> "\". Expected format is: YYYY-MM-DD") Right
$ parseTimeM True defaultTimeLocale "%Y-%-m-%-d" s
criteriaParser :: String -> Either String ListCriteria criteriaParser :: String -> Either String ListCriteria
criteriaParser s' | t == T.pack "installed" = Right ListInstalled criteriaParser s' | t == T.pack "installed" = Right $ ListInstalled True
| t == T.pack "set" = Right ListSet | t == T.pack "set" = Right $ ListSet True
| t == T.pack "available" = Right ListAvailable | t == T.pack "available" = Right $ ListAvailable True
| otherwise = Left ("Unknown criteria: " <> s') | t == T.pack "+installed" = Right $ ListInstalled True
| t == T.pack "+set" = Right $ ListSet True
| t == T.pack "+available" = Right $ ListAvailable True
| t == T.pack "-installed" = Right $ ListInstalled False
| t == T.pack "-set" = Right $ ListSet False
| t == T.pack "-available" = Right $ ListAvailable False
| otherwise = Left ("Unknown criteria: " <> s')
where t = T.toLower (T.pack s') where t = T.toLower (T.pack s')
@ -455,10 +468,10 @@ tagCompleter tool add = listIOCompleter $ do
pure $ nub $ (add ++) $ fmap tagToString allTags pure $ nub $ (add ++) $ fmap tagToString allTags
VLeft _ -> pure (nub $ ["recommended", "latest", "latest-prerelease"] ++ add) VLeft _ -> pure (nub $ ["recommended", "latest", "latest-prerelease"] ++ add)
versionCompleter :: Maybe ListCriteria -> Tool -> Completer versionCompleter :: [ListCriteria] -> Tool -> Completer
versionCompleter criteria tool = versionCompleter' criteria tool (const True) versionCompleter criteria tool = versionCompleter' criteria tool (const True)
versionCompleter' :: Maybe ListCriteria -> Tool -> (Version -> Bool) -> Completer versionCompleter' :: [ListCriteria] -> Tool -> (Version -> Bool) -> Completer
versionCompleter' criteria tool filter' = listIOCompleter $ do versionCompleter' criteria tool filter' = listIOCompleter $ do
dirs' <- liftIO getAllDirs dirs' <- liftIO getAllDirs
let loggerConfig = LoggerConfig let loggerConfig = LoggerConfig
@ -487,7 +500,7 @@ versionCompleter' criteria tool filter' = listIOCompleter $ do
runEnv = flip runReaderT appState runEnv = flip runReaderT appState
installedVersions <- runEnv $ listVersions (Just tool) criteria installedVersions <- runEnv $ listVersions (Just tool) criteria False False (Nothing, Nothing)
return $ fmap (T.unpack . prettyVer) . filter filter' . fmap lVer $ installedVersions return $ fmap (T.unpack . prettyVer) . filter filter' . fmap lVer $ installedVersions
@ -655,6 +668,7 @@ fromVersion :: ( HasLog env
-> Tool -> Tool
-> Excepts -> Excepts
'[ TagNotFound '[ TagNotFound
, DayNotFound
, NextVerNotFound , NextVerNotFound
, NoToolVersionSet , NoToolVersionSet
] m (GHCTargetVersion, Maybe VersionInfo) ] m (GHCTargetVersion, Maybe VersionInfo)
@ -673,6 +687,7 @@ fromVersion' :: ( HasLog env
-> Tool -> Tool
-> Excepts -> Excepts
'[ TagNotFound '[ TagNotFound
, DayNotFound
, NextVerNotFound , NextVerNotFound
, NoToolVersionSet , NoToolVersionSet
] m (GHCTargetVersion, Maybe VersionInfo) ] m (GHCTargetVersion, Maybe VersionInfo)
@ -707,9 +722,17 @@ fromVersion' (SetToolVersion v) tool = do
fromVersion' (SetToolTag Latest) tool = do fromVersion' (SetToolTag Latest) tool = do
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
bimap mkTVer Just <$> getLatest dls tool ?? TagNotFound Latest tool bimap mkTVer Just <$> getLatest dls tool ?? TagNotFound Latest tool
fromVersion' (SetToolDay day) tool = do
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
bimap mkTVer Just <$> case getByReleaseDay dls tool day of
Left ad -> throwE $ DayNotFound day tool ad
Right v -> pure v
fromVersion' (SetToolTag LatestPrerelease) tool = do fromVersion' (SetToolTag LatestPrerelease) tool = do
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
bimap mkTVer Just <$> getLatestPrerelease dls tool ?? TagNotFound LatestPrerelease tool bimap mkTVer Just <$> getLatestPrerelease dls tool ?? TagNotFound LatestPrerelease tool
fromVersion' (SetToolTag LatestNightly) tool = do
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
bimap mkTVer Just <$> getLatestNightly dls tool ?? TagNotFound LatestNightly tool
fromVersion' (SetToolTag Recommended) tool = do fromVersion' (SetToolTag Recommended) tool = do
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
bimap mkTVer Just <$> getRecommended dls tool ?? TagNotFound Recommended tool bimap mkTVer Just <$> getRecommended dls tool ?? TagNotFound Recommended tool
@ -779,7 +802,7 @@ checkForUpdates :: ( MonadReader env m
=> m [(Tool, Version)] => m [(Tool, Version)]
checkForUpdates = do checkForUpdates = do
GHCupInfo { _ghcupDownloads = dls } <- getGHCupInfo GHCupInfo { _ghcupDownloads = dls } <- getGHCupInfo
lInstalled <- listVersions Nothing (Just ListInstalled) lInstalled <- listVersions Nothing [ListInstalled True] False False (Nothing, Nothing)
let latestInstalled tool = (fmap lVer . lastMay . filter (\lr -> lTool lr == tool)) lInstalled let latestInstalled tool = (fmap lVer . lastMay . filter (\lr -> lTool lr == tool)) lInstalled
ghcup <- forMM (getLatest dls GHCup) $ \(l, _) -> do ghcup <- forMM (getLatest dls GHCup) $ \(l, _) -> do

View File

@ -170,7 +170,7 @@ ghcCompileOpts =
) )
(short 'v' <> long "version" <> metavar "VERSION" <> help (short 'v' <> long "version" <> metavar "VERSION" <> help
"The tool version to compile" "The tool version to compile"
<> (completer $ versionCompleter Nothing GHC) <> (completer $ versionCompleter [] GHC)
) )
) <|> ) <|>
(GHC.GitDist <$> (GitBranch <$> option (GHC.GitDist <$> (GitBranch <$> option
@ -205,7 +205,7 @@ ghcCompileOpts =
<> metavar "BOOTSTRAP_GHC" <> metavar "BOOTSTRAP_GHC"
<> help <> help
"The GHC version (or full path) to bootstrap with (must be installed)" "The GHC version (or full path) to bootstrap with (must be installed)"
<> (completer $ versionCompleter Nothing GHC) <> (completer $ versionCompleter [] GHC)
) )
<*> optional <*> optional
(option (option
@ -258,7 +258,7 @@ ghcCompileOpts =
) )
(short 'o' <> long "overwrite-version" <> metavar "OVERWRITE_VERSION" <> help (short 'o' <> long "overwrite-version" <> metavar "OVERWRITE_VERSION" <> help
"Allows to overwrite the finally installed VERSION with a different one, e.g. when you build 8.10.4 with your own patches, you might want to set this to '8.10.4-p1'" "Allows to overwrite the finally installed VERSION with a different one, e.g. when you build 8.10.4 with your own patches, you might want to set this to '8.10.4-p1'"
<> (completer $ versionCompleter Nothing GHC) <> (completer $ versionCompleter [] GHC)
) )
) )
<*> optional <*> optional
@ -291,7 +291,7 @@ hlsCompileOpts =
) )
(short 'v' <> long "version" <> metavar "VERSION" <> help (short 'v' <> long "version" <> metavar "VERSION" <> help
"The version to compile (pulled from hackage)" "The version to compile (pulled from hackage)"
<> (completer $ versionCompleter' Nothing HLS (either (const False) (const True) . V.pvp . V.prettyVer)) <> (completer $ versionCompleter' [] HLS (either (const False) (const True) . V.pvp . V.prettyVer))
) )
) )
<|> <|>
@ -311,7 +311,7 @@ hlsCompileOpts =
) )
(long "source-dist" <> metavar "VERSION" <> help (long "source-dist" <> metavar "VERSION" <> help
"The version to compile (pulled from packaged git sources)" "The version to compile (pulled from packaged git sources)"
<> (completer $ versionCompleter Nothing HLS) <> (completer $ versionCompleter [] HLS)
) )
)) ))
<|> <|>
@ -343,7 +343,7 @@ hlsCompileOpts =
) )
(short 'o' <> long "overwrite-version" <> metavar "OVERWRITE_VERSION" <> help (short 'o' <> long "overwrite-version" <> metavar "OVERWRITE_VERSION" <> help
"Allows to overwrite the finally installed VERSION with a different one, e.g. when you build 8.10.4 with your own patches, you might want to set this to '8.10.4-p1'" "Allows to overwrite the finally installed VERSION with a different one, e.g. when you build 8.10.4 with your own patches, you might want to set this to '8.10.4-p1'"
<> (completer $ versionCompleter Nothing HLS) <> (completer $ versionCompleter [] HLS)
) )
) )
<|> <|>
@ -403,7 +403,7 @@ hlsCompileOpts =
option (eitherReader ghcVersionTagEither) option (eitherReader ghcVersionTagEither)
( long "ghc" <> metavar "GHC_VERSION|TAG" <> help "For which GHC version to compile for (can be specified multiple times)" ( long "ghc" <> metavar "GHC_VERSION|TAG" <> help "For which GHC version to compile for (can be specified multiple times)"
<> completer (tagCompleter GHC []) <> completer (tagCompleter GHC [])
<> completer (versionCompleter Nothing GHC)) <> completer (versionCompleter [] GHC))
) )
<*> many (argument str (metavar "CABAL_ARGS" <> help "Additional arguments to cabal install, prefix with '-- ' (longopts)")) <*> many (argument str (metavar "CABAL_ARGS" <> help "Additional arguments to cabal install, prefix with '-- ' (longopts)"))
@ -453,6 +453,7 @@ type HLSEffects = '[ AlreadyInstalled
, UnknownArchive , UnknownArchive
, TarDirDoesNotExist , TarDirDoesNotExist
, TagNotFound , TagNotFound
, DayNotFound
, NextVerNotFound , NextVerNotFound
, NoToolVersionSet , NoToolVersionSet
, NotInstalled , NotInstalled

View File

@ -184,7 +184,7 @@ installOpts tool =
<> completer (toolDlCompleter (fromMaybe GHC tool)) <> completer (toolDlCompleter (fromMaybe GHC tool))
) )
) )
<*> (Just <$> toolVersionTagArgument Nothing tool) <*> (Just <$> toolVersionTagArgument [] tool)
) )
<|> pure (Nothing, Nothing) <|> pure (Nothing, Nothing)
) )
@ -241,6 +241,7 @@ type InstallEffects = '[ AlreadyInstalled
, NotInstalled , NotInstalled
, BuildFailed , BuildFailed
, TagNotFound , TagNotFound
, DayNotFound
, DigestError , DigestError
, ContentLengthError , ContentLengthError
, GPGError , GPGError
@ -284,6 +285,7 @@ type InstallGHCEffects = '[ AlreadyInstalled
, NotInstalled , NotInstalled
, ProcessError , ProcessError
, TagNotFound , TagNotFound
, DayNotFound
, TarDirDoesNotExist , TarDirDoesNotExist
, UninstallFailed , UninstallFailed
, UnknownArchive , UnknownArchive
@ -333,7 +335,7 @@ install installCommand settings getAppState' runLogger = case installCommand of
runInstGHC s'{ settings = settings {noVerify = True}} $ do runInstGHC s'{ settings = settings {noVerify = True}} $ do
(v, vi) <- liftE $ fromVersion instVer GHC (v, vi) <- liftE $ fromVersion instVer GHC
liftE $ runBothE' (installGHCBindist liftE $ runBothE' (installGHCBindist
(DownloadInfo uri (Just $ RegexDir "ghc-.*") "" Nothing) (DownloadInfo uri (Just $ RegexDir "ghc-.*") "" Nothing Nothing)
(_tvVersion v) (_tvVersion v)
(maybe GHCupInternal IsolateDir isolateDir) (maybe GHCupInternal IsolateDir isolateDir)
forceInstall forceInstall
@ -403,7 +405,7 @@ install installCommand settings getAppState' runLogger = case installCommand of
runInstTool s'{ settings = settings { noVerify = True}} $ do runInstTool s'{ settings = settings { noVerify = True}} $ do
(_tvVersion -> v, vi) <- liftE $ fromVersion instVer Cabal (_tvVersion -> v, vi) <- liftE $ fromVersion instVer Cabal
liftE $ runBothE' (installCabalBindist liftE $ runBothE' (installCabalBindist
(DownloadInfo uri Nothing "" Nothing) (DownloadInfo uri Nothing "" Nothing Nothing)
v v
(maybe GHCupInternal IsolateDir isolateDir) (maybe GHCupInternal IsolateDir isolateDir)
forceInstall forceInstall
@ -453,7 +455,7 @@ install installCommand settings getAppState' runLogger = case installCommand of
(_tvVersion -> v, vi) <- liftE $ fromVersion instVer HLS (_tvVersion -> v, vi) <- liftE $ fromVersion instVer HLS
-- TODO: support legacy -- TODO: support legacy
liftE $ runBothE' (installHLSBindist liftE $ runBothE' (installHLSBindist
(DownloadInfo uri (if isWindows then Nothing else Just (RegexDir "haskell-language-server-*")) "" Nothing) (DownloadInfo uri (if isWindows then Nothing else Just (RegexDir "haskell-language-server-*")) "" Nothing Nothing)
v v
(maybe GHCupInternal IsolateDir isolateDir) (maybe GHCupInternal IsolateDir isolateDir)
forceInstall forceInstall
@ -502,7 +504,7 @@ install installCommand settings getAppState' runLogger = case installCommand of
runInstTool s'{ settings = settings { noVerify = True}} $ do runInstTool s'{ settings = settings { noVerify = True}} $ do
(_tvVersion -> v, vi) <- liftE $ fromVersion instVer Stack (_tvVersion -> v, vi) <- liftE $ fromVersion instVer Stack
liftE $ runBothE' (installStackBindist liftE $ runBothE' (installStackBindist
(DownloadInfo uri Nothing "" Nothing) (DownloadInfo uri Nothing "" Nothing Nothing)
v v
(maybe GHCupInternal IsolateDir isolateDir) (maybe GHCupInternal IsolateDir isolateDir)
forceInstall forceInstall

View File

@ -2,6 +2,7 @@
{-# LANGUAGE DataKinds #-} {-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE RankNTypes #-} {-# LANGUAGE RankNTypes #-}
@ -14,6 +15,7 @@ import GHCup
import GHCup.Prelude import GHCup.Prelude
import GHCup.Types import GHCup.Types
import GHCup.OptParse.Common import GHCup.OptParse.Common
import GHCup.Prelude.String.QQ
#if !MIN_VERSION_base(4,13,0) #if !MIN_VERSION_base(4,13,0)
import Control.Monad.Fail ( MonadFail ) import Control.Monad.Fail ( MonadFail )
@ -24,6 +26,7 @@ import Data.Char
import Data.List ( intercalate, sort ) import Data.List ( intercalate, sort )
import Data.Functor import Data.Functor
import Data.Maybe import Data.Maybe
import Data.Time.Calendar ( Day )
import Data.Versions hiding ( str ) import Data.Versions hiding ( str )
import Data.Void import Data.Void
import Options.Applicative hiding ( style ) import Options.Applicative hiding ( style )
@ -50,6 +53,10 @@ import qualified Text.Megaparsec.Char as MPC
data ListOptions = ListOptions data ListOptions = ListOptions
{ loTool :: Maybe Tool { loTool :: Maybe Tool
, lCriteria :: Maybe ListCriteria , lCriteria :: Maybe ListCriteria
, lFrom :: Maybe Day
, lTo :: Maybe Day
, lHideOld :: Bool
, lShowNightly :: Bool
, lRawFormat :: Bool , lRawFormat :: Bool
} }
@ -60,7 +67,6 @@ data ListOptions = ListOptions
--[ Parsers ]-- --[ Parsers ]--
--------------- ---------------
listOpts :: Parser ListOptions listOpts :: Parser ListOptions
listOpts = listOpts =
ListOptions ListOptions
@ -69,7 +75,7 @@ listOpts =
(eitherReader toolParser) (eitherReader toolParser)
(short 't' <> long "tool" <> metavar "<ghc|cabal|hls|stack>" <> help (short 't' <> long "tool" <> metavar "<ghc|cabal|hls|stack>" <> help
"Tool to list versions for. Default is all" "Tool to list versions for. Default is all"
<> completer (toolCompleter) <> completer toolCompleter
) )
) )
<*> optional <*> optional
@ -78,15 +84,53 @@ listOpts =
( short 'c' ( short 'c'
<> long "show-criteria" <> long "show-criteria"
<> metavar "<installed|set|available>" <> metavar "<installed|set|available>"
<> help "Show only installed/set/available tool versions" <> help "Apply filtering criteria, prefix with + or -"
<> completer (listCompleter ["installed", "set", "available"]) <> completer (listCompleter
[ "+installed", "+set", "+available", "-installed", "-set", "-available"])
) )
) )
<*> optional
(option
(eitherReader dayParser)
(short 's' <> long "since" <> metavar "YYYY-MM-DD" <> help
"List only tools with release date starting at YYYY-MM-DD or later"
<> completer toolCompleter
)
)
<*> optional
(option
(eitherReader dayParser)
(short 'u' <> long "until" <> metavar "YYYY-MM-DD" <> help
"List only tools with release date earlier than YYYY-MM-DD"
<> completer toolCompleter
)
)
<*> switch
(short 'o' <> long "hide-old" <> help "Hide 'old' GHC versions (installed ones are always shown)"
)
<*> switch
(short 'n' <> long "show-nightly" <> help "Show nightlies (installed ones are always shown)"
)
<*> switch <*> switch
(short 'r' <> long "raw-format" <> help "More machine-parsable format" (short 'r' <> long "raw-format" <> help "More machine-parsable format"
) )
--------------
--[ Footer ]--
--------------
listToolFooter :: String
listToolFooter = [s|Discussion:
Lists tool versions with optional criteria.
Nightlies are by default hidden.
Examples:
# query nightlies in a specific range
ghcup list --show-nightly --since 2022-12-07 --until 2022-12-31
# show all installed GHC versions
ghcup list -t ghc -c installed|]
----------------- -----------------
@ -105,9 +149,11 @@ printListResult no_color raw lr = do
printTag Recommended = color Green "recommended" printTag Recommended = color Green "recommended"
printTag Latest = color Yellow "latest" printTag Latest = color Yellow "latest"
printTag Prerelease = color Red "prerelease" printTag Prerelease = color Red "prerelease"
printTag Nightly = color Red "nightly"
printTag (Base pvp'') = "base-" ++ T.unpack (prettyPVP pvp'') printTag (Base pvp'') = "base-" ++ T.unpack (prettyPVP pvp'')
printTag (UnknownTag t ) = t printTag (UnknownTag t ) = t
printTag LatestPrerelease = color Red "latest-prerelease" printTag LatestPrerelease = color Red "latest-prerelease"
printTag LatestNightly = color Red "latest-nightly"
printTag Old = "" printTag Old = ""
let let
@ -136,6 +182,9 @@ printListResult no_color raw lr = do
) )
++ (if fromSrc then [color Blue "compiled"] else mempty) ++ (if fromSrc then [color Blue "compiled"] else mempty)
++ (if lStray then [color Yellow "stray"] else mempty) ++ (if lStray then [color Yellow "stray"] else mempty)
++ (case lReleaseDay of
Nothing -> mempty
Just d -> [color Blue (show d)])
++ (if lNoBindist ++ (if lNoBindist
then [color Red "no-bindist"] then [color Red "no-bindist"]
else mempty else mempty
@ -260,7 +309,7 @@ list :: ( Monad m
-> m ExitCode -> m ExitCode
list ListOptions{..} no_color runAppState = list ListOptions{..} no_color runAppState =
runAppState (do runAppState (do
l <- listVersions loTool lCriteria l <- listVersions loTool (maybeToList lCriteria) lHideOld lShowNightly (lFrom, lTo)
liftIO $ printListResult no_color lRawFormat l liftIO $ printListResult no_color lRawFormat l
pure ExitSuccess pure ExitSuccess
) )

View File

@ -76,8 +76,8 @@ nuke appState runLogger = do
lift $ logInfo "Initiating Nuclear Sequence 🚀🚀🚀" lift $ logInfo "Initiating Nuclear Sequence 🚀🚀🚀"
lift $ logInfo "Nuking in 3...2...1" lift $ logInfo "Nuking in 3...2...1"
lInstalled <- lift $ listVersions Nothing (Just ListInstalled) lInstalled <- lift $ listVersions Nothing [ListInstalled True] False True (Nothing, Nothing)
forM_ lInstalled (liftE . rmTool) forM_ lInstalled (liftE . rmTool)

View File

@ -83,7 +83,7 @@ prefetchP = subparser
<$> (PrefetchGHCOptions <$> (PrefetchGHCOptions
<$> ( switch (short 's' <> long "source" <> help "Download source tarball instead of bindist") <**> helper ) <$> ( switch (short 's' <> long "source" <> help "Download source tarball instead of bindist") <**> helper )
<*> optional (option str (short 'd' <> long "directory" <> help "directory to download into (default: ~/.ghcup/cache/)" <> completer (bashCompleter "directory")))) <*> optional (option str (short 'd' <> long "directory" <> help "directory to download into (default: ~/.ghcup/cache/)" <> completer (bashCompleter "directory"))))
<*> optional (toolVersionTagArgument Nothing (Just GHC)) ) <*> optional (toolVersionTagArgument [] (Just GHC)) )
( progDesc "Download GHC assets for installation") ( progDesc "Download GHC assets for installation")
) )
<> <>
@ -92,7 +92,7 @@ prefetchP = subparser
(info (info
(PrefetchCabal (PrefetchCabal
<$> fmap PrefetchOptions (optional (option str (short 'd' <> long "directory" <> help "directory to download into (default: ~/.ghcup/cache/)" <> completer (bashCompleter "directory")))) <$> fmap PrefetchOptions (optional (option str (short 'd' <> long "directory" <> help "directory to download into (default: ~/.ghcup/cache/)" <> completer (bashCompleter "directory"))))
<*> ( optional (toolVersionTagArgument Nothing (Just Cabal)) <**> helper )) <*> ( optional (toolVersionTagArgument [] (Just Cabal)) <**> helper ))
( progDesc "Download cabal assets for installation") ( progDesc "Download cabal assets for installation")
) )
<> <>
@ -101,7 +101,7 @@ prefetchP = subparser
(info (info
(PrefetchHLS (PrefetchHLS
<$> fmap PrefetchOptions (optional (option str (short 'd' <> long "directory" <> help "directory to download into (default: ~/.ghcup/cache/)" <> completer (bashCompleter "directory")))) <$> fmap PrefetchOptions (optional (option str (short 'd' <> long "directory" <> help "directory to download into (default: ~/.ghcup/cache/)" <> completer (bashCompleter "directory"))))
<*> ( optional (toolVersionTagArgument Nothing (Just HLS)) <**> helper )) <*> ( optional (toolVersionTagArgument [] (Just HLS)) <**> helper ))
( progDesc "Download HLS assets for installation") ( progDesc "Download HLS assets for installation")
) )
<> <>
@ -110,7 +110,7 @@ prefetchP = subparser
(info (info
(PrefetchStack (PrefetchStack
<$> fmap PrefetchOptions (optional (option str (short 'd' <> long "directory" <> help "directory to download into (default: ~/.ghcup/cache/)" <> completer (bashCompleter "directory")))) <$> fmap PrefetchOptions (optional (option str (short 'd' <> long "directory" <> help "directory to download into (default: ~/.ghcup/cache/)" <> completer (bashCompleter "directory"))))
<*> ( optional (toolVersionTagArgument Nothing (Just Stack)) <**> helper )) <*> ( optional (toolVersionTagArgument [] (Just Stack)) <**> helper ))
( progDesc "Download stack assets for installation") ( progDesc "Download stack assets for installation")
) )
<> <>
@ -148,6 +148,7 @@ Examples:
type PrefetchEffects = '[ TagNotFound type PrefetchEffects = '[ TagNotFound
, DayNotFound
, NextVerNotFound , NextVerNotFound
, NoToolVersionSet , NoToolVersionSet
, NoDownload , NoDownload

View File

@ -80,19 +80,19 @@ rmParser =
<> command <> command
"cabal" "cabal"
( RmCabal ( RmCabal
<$> info (versionParser' (Just ListInstalled) (Just Cabal) <**> helper) <$> info (versionParser' [ListInstalled True] (Just Cabal) <**> helper)
(progDesc "Remove Cabal version") (progDesc "Remove Cabal version")
) )
<> command <> command
"hls" "hls"
( RmHLS ( RmHLS
<$> info (versionParser' (Just ListInstalled) (Just HLS) <**> helper) <$> info (versionParser' [ListInstalled True] (Just HLS) <**> helper)
(progDesc "Remove haskell-language-server version") (progDesc "Remove haskell-language-server version")
) )
<> command <> command
"stack" "stack"
( RmStack ( RmStack
<$> info (versionParser' (Just ListInstalled) (Just Stack) <**> helper) <$> info (versionParser' [ListInstalled True] (Just Stack) <**> helper)
(progDesc "Remove stack version") (progDesc "Remove stack version")
) )
) )
@ -102,7 +102,7 @@ rmParser =
rmOpts :: Maybe Tool -> Parser RmOptions rmOpts :: Maybe Tool -> Parser RmOptions
rmOpts tool = RmOptions <$> ghcVersionArgument (Just ListInstalled) tool rmOpts tool = RmOptions <$> ghcVersionArgument [ListInstalled True] tool

View File

@ -92,7 +92,7 @@ runOpts =
(eitherReader ghcVersionTagEither) (eitherReader ghcVersionTagEither)
(metavar "GHC_VERSION" <> long "ghc" <> help "The ghc version" (metavar "GHC_VERSION" <> long "ghc" <> help "The ghc version"
<> completer (tagCompleter GHC []) <> completer (tagCompleter GHC [])
<> (completer $ versionCompleter Nothing GHC) <> (completer $ versionCompleter [] GHC)
) )
) )
<*> optional <*> optional
@ -100,7 +100,7 @@ runOpts =
(eitherReader toolVersionTagEither) (eitherReader toolVersionTagEither)
(metavar "CABAL_VERSION" <> long "cabal" <> help "The cabal version" (metavar "CABAL_VERSION" <> long "cabal" <> help "The cabal version"
<> completer (tagCompleter Cabal []) <> completer (tagCompleter Cabal [])
<> (completer $ versionCompleter Nothing Cabal) <> (completer $ versionCompleter [] Cabal)
) )
) )
<*> optional <*> optional
@ -108,7 +108,7 @@ runOpts =
(eitherReader toolVersionTagEither) (eitherReader toolVersionTagEither)
(metavar "HLS_VERSION" <> long "hls" <> help "The HLS version" (metavar "HLS_VERSION" <> long "hls" <> help "The HLS version"
<> completer (tagCompleter HLS []) <> completer (tagCompleter HLS [])
<> (completer $ versionCompleter Nothing HLS) <> (completer $ versionCompleter [] HLS)
) )
) )
<*> optional <*> optional
@ -116,7 +116,7 @@ runOpts =
(eitherReader toolVersionTagEither) (eitherReader toolVersionTagEither)
(metavar "STACK_VERSION" <> long "stack" <> help "The stack version" (metavar "STACK_VERSION" <> long "stack" <> help "The stack version"
<> completer (tagCompleter Stack []) <> completer (tagCompleter Stack [])
<> (completer $ versionCompleter Nothing Stack) <> (completer $ versionCompleter [] Stack)
) )
) )
<*> optional <*> optional
@ -132,7 +132,7 @@ runOpts =
<*> switch <*> switch
(short 'q' <> long "quick" <> help "Avoid any expensive work (such as downloads, version/tag resolution etc.). Disables --install.") (short 'q' <> long "quick" <> help "Avoid any expensive work (such as downloads, version/tag resolution etc.). Disables --install.")
<*> many (argument str (metavar "COMMAND" <> help "The command to run, with arguments (use longopts --). If omitted, just prints the created bin/ dir to stdout and exits.")) <*> many (argument str (metavar "COMMAND" <> help "The command to run, with arguments (use longopts --). If omitted, just prints the created bin/ dir to stdout and exits."))
@ -175,6 +175,7 @@ type RunEffects = '[ AlreadyInstalled
, NotInstalled , NotInstalled
, BuildFailed , BuildFailed
, TagNotFound , TagNotFound
, DayNotFound
, DigestError , DigestError
, ContentLengthError , ContentLengthError
, GPGError , GPGError
@ -282,6 +283,7 @@ run RunOptions{..} runAppState leanAppstate runLogger = do
) )
=> Excepts => Excepts
'[ TagNotFound '[ TagNotFound
, DayNotFound
, NextVerNotFound , NextVerNotFound
, NoToolVersionSet , NoToolVersionSet
] (ResourceT (ReaderT AppState m)) Toolchain ] (ResourceT (ReaderT AppState m)) Toolchain
@ -332,6 +334,7 @@ run RunOptions{..} runAppState leanAppstate runLogger = do
-> FilePath -> FilePath
-> Excepts -> Excepts
'[ TagNotFound '[ TagNotFound
, DayNotFound
, NextVerNotFound , NextVerNotFound
, NoToolVersionSet , NoToolVersionSet
, UnknownArchive , UnknownArchive

View File

@ -139,9 +139,9 @@ setParser =
setOpts :: Tool -> Parser SetOptions setOpts :: Tool -> Parser SetOptions
setOpts tool = SetOptions <$> setOpts tool = SetOptions <$>
(fromMaybe SetRecommended <$> (fromMaybe SetRecommended <$>
optional (setVersionArgument (Just ListInstalled) tool)) optional (setVersionArgument [ListInstalled True] tool))
setVersionArgument :: Maybe ListCriteria -> Tool -> Parser SetToolVersion setVersionArgument :: [ListCriteria] -> Tool -> Parser SetToolVersion
setVersionArgument criteria tool = setVersionArgument criteria tool =
argument (eitherReader setEither) argument (eitherReader setEither)
(metavar "VERSION|TAG|next" (metavar "VERSION|TAG|next"
@ -184,6 +184,7 @@ setFooter = [s|Discussion:
type SetGHCEffects = '[ FileDoesNotExistError type SetGHCEffects = '[ FileDoesNotExistError
, NotInstalled , NotInstalled
, TagNotFound , TagNotFound
, DayNotFound
, NextVerNotFound , NextVerNotFound
, NoToolVersionSet] , NoToolVersionSet]
@ -198,6 +199,7 @@ runSetGHC runAppState =
type SetCabalEffects = '[ NotInstalled type SetCabalEffects = '[ NotInstalled
, TagNotFound , TagNotFound
, DayNotFound
, NextVerNotFound , NextVerNotFound
, NoToolVersionSet] , NoToolVersionSet]
@ -212,6 +214,7 @@ runSetCabal runAppState =
type SetHLSEffects = '[ NotInstalled type SetHLSEffects = '[ NotInstalled
, TagNotFound , TagNotFound
, DayNotFound
, NextVerNotFound , NextVerNotFound
, NoToolVersionSet] , NoToolVersionSet]
@ -226,6 +229,7 @@ runSetHLS runAppState =
type SetStackEffects = '[ NotInstalled type SetStackEffects = '[ NotInstalled
, TagNotFound , TagNotFound
, DayNotFound
, NextVerNotFound , NextVerNotFound
, NoToolVersionSet] , NoToolVersionSet]

View File

@ -112,7 +112,7 @@ testOpts tool =
<> completer (toolDlCompleter (fromMaybe GHC tool)) <> completer (toolDlCompleter (fromMaybe GHC tool))
) )
) )
<*> (Just <$> toolVersionTagArgument Nothing tool) <*> (Just <$> toolVersionTagArgument [] tool)
) )
<|> pure (Nothing, Nothing) <|> pure (Nothing, Nothing)
) )
@ -140,6 +140,7 @@ type TestGHCEffects = [ DigestError
, TestFailed , TestFailed
, NextVerNotFound , NextVerNotFound
, TagNotFound , TagNotFound
, DayNotFound
, NoToolVersionSet , NoToolVersionSet
] ]
@ -173,7 +174,7 @@ test testCommand settings getAppState' runLogger = case testCommand of
Just uri -> do Just uri -> do
runTestGHC s'{ settings = settings {noVerify = True}} $ do runTestGHC s'{ settings = settings {noVerify = True}} $ do
(v, vi) <- liftE $ fromVersion testVer GHC (v, vi) <- liftE $ fromVersion testVer GHC
liftE $ testGHCBindist (DownloadInfo uri (Just $ RegexDir ".*/.*") "" Nothing) (_tvVersion v) addMakeArgs liftE $ testGHCBindist (DownloadInfo uri (Just $ RegexDir ".*/.*") "" Nothing Nothing) (_tvVersion v) addMakeArgs
pure vi pure vi
) )
>>= \case >>= \case

View File

@ -82,7 +82,7 @@ whereisP = subparser
command command
"ghc" "ghc"
(WhereisTool GHC <$> info (WhereisTool GHC <$> info
( optional (toolVersionTagArgument Nothing (Just GHC)) <**> helper ) ( optional (toolVersionTagArgument [] (Just GHC)) <**> helper )
( progDesc "Get GHC location" ( progDesc "Get GHC location"
<> footerDoc (Just $ text whereisGHCFooter )) <> footerDoc (Just $ text whereisGHCFooter ))
) )
@ -90,7 +90,7 @@ whereisP = subparser
command command
"cabal" "cabal"
(WhereisTool Cabal <$> info (WhereisTool Cabal <$> info
( optional (toolVersionTagArgument Nothing (Just Cabal)) <**> helper ) ( optional (toolVersionTagArgument [] (Just Cabal)) <**> helper )
( progDesc "Get cabal location" ( progDesc "Get cabal location"
<> footerDoc (Just $ text whereisCabalFooter )) <> footerDoc (Just $ text whereisCabalFooter ))
) )
@ -98,7 +98,7 @@ whereisP = subparser
command command
"hls" "hls"
(WhereisTool HLS <$> info (WhereisTool HLS <$> info
( optional (toolVersionTagArgument Nothing (Just HLS)) <**> helper ) ( optional (toolVersionTagArgument [] (Just HLS)) <**> helper )
( progDesc "Get HLS location" ( progDesc "Get HLS location"
<> footerDoc (Just $ text whereisHLSFooter )) <> footerDoc (Just $ text whereisHLSFooter ))
) )
@ -106,7 +106,7 @@ whereisP = subparser
command command
"stack" "stack"
(WhereisTool Stack <$> info (WhereisTool Stack <$> info
( optional (toolVersionTagArgument Nothing (Just Stack)) <**> helper ) ( optional (toolVersionTagArgument [] (Just Stack)) <**> helper )
( progDesc "Get stack location" ( progDesc "Get stack location"
<> footerDoc (Just $ text whereisStackFooter )) <> footerDoc (Just $ text whereisStackFooter ))
) )
@ -222,6 +222,7 @@ type WhereisEffects = '[ NotInstalled
, NoToolVersionSet , NoToolVersionSet
, NextVerNotFound , NextVerNotFound
, TagNotFound , TagNotFound
, DayNotFound
] ]

View File

@ -240,7 +240,7 @@ Report bugs at <https://github.com/haskell/ghcup-hs/issues>|]
_ _
| Just False <- optVerbose -> pure () | Just False <- optVerbose -> pure ()
| otherwise -> lookupEnv "GHCUP_SKIP_UPDATE_CHECK" >>= \case | otherwise -> lookupEnv "GHCUP_SKIP_UPDATE_CHECK" >>= \case
Nothing -> void . flip runReaderT s' . runE @'[TagNotFound, NextVerNotFound, NoToolVersionSet] $ do Nothing -> void . flip runReaderT s' . runE @'[TagNotFound, DayNotFound, NextVerNotFound, NoToolVersionSet] $ do
newTools <- lift checkForUpdates newTools <- lift checkForUpdates
forM_ newTools $ \newTool@(t, l) -> do forM_ newTools $ \newTool@(t, l) -> do
-- https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/283 -- https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/283
@ -335,6 +335,7 @@ Report bugs at <https://github.com/haskell/ghcup-hs/issues>|]
-> (Tool, Version) -> (Tool, Version)
-> Excepts -> Excepts
'[ TagNotFound '[ TagNotFound
, DayNotFound
, NextVerNotFound , NextVerNotFound
, NoToolVersionSet , NoToolVersionSet
] m Bool ] m Bool
@ -370,6 +371,7 @@ Report bugs at <https://github.com/haskell/ghcup-hs/issues>|]
-> Version -> Version
-> Excepts -> Excepts
'[ TagNotFound '[ TagNotFound
, DayNotFound
, NextVerNotFound , NextVerNotFound
, NoToolVersionSet , NoToolVersionSet
] m Bool ] m Bool

@ -1 +1 @@
Subproject commit 0b98de04cce150d70ef74a733513759e95577769 Subproject commit 92efb732aceec87089327201c48f65f6158ed3d8

View File

@ -203,6 +203,34 @@ url-source:
- "https://raw.githubusercontent.com/haskell/ghcup-metadata/master/ghcup-prereleases-0.0.7.yaml" - "https://raw.githubusercontent.com/haskell/ghcup-metadata/master/ghcup-prereleases-0.0.7.yaml"
``` ```
### Nightlies
Nightlies are just a nother 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 integration
Stack manages GHC versions internally by default. In order to make it use ghcup installed Stack manages GHC versions internally by default. In order to make it use ghcup installed

View File

@ -137,7 +137,7 @@ library
, pretty-terminal ^>=0.1.0.0 , pretty-terminal ^>=0.1.0.0
, regex-posix ^>=0.96 , regex-posix ^>=0.96
, resourcet ^>=1.2.2 , resourcet ^>=1.2.2
, retry ^>=0.8.1.2 , retry ^>=0.8.1.2 || ^>=0.9
, safe ^>=0.3.18 , safe ^>=0.3.18
, safe-exceptions ^>=0.1 , safe-exceptions ^>=0.1
, split ^>=0.2.3.4 , split ^>=0.2.3.4
@ -146,7 +146,7 @@ library
, template-haskell >=2.7 && <2.20 , template-haskell >=2.7 && <2.20
, temporary ^>=1.3 , temporary ^>=1.3
, text ^>=2.0 , text ^>=2.0
, time ^>=1.9.3 , time ^>=1.9.3 || ^>=1.10 || ^>=1.11
, transformers ^>=0.5 , transformers ^>=0.5
, unliftio-core ^>=0.2.0.1 , unliftio-core ^>=0.2.0.1
, unordered-containers ^>=0.2.10.0 , unordered-containers ^>=0.2.10.0
@ -269,6 +269,7 @@ executable ghcup
, template-haskell >=2.7 && <2.20 , template-haskell >=2.7 && <2.20
, temporary ^>=1.3 , temporary ^>=1.3
, text ^>=2.0 , text ^>=2.0
, time ^>=1.9.3 || ^>=1.10 || ^>=1.11
, unordered-containers ^>=0.2 , unordered-containers ^>=0.2
, uri-bytestring ^>=0.3.2.2 , uri-bytestring ^>=0.3.2.2
, utf8-string ^>=1.0 , utf8-string ^>=1.0
@ -335,6 +336,7 @@ test-suite ghcup-test
, QuickCheck ^>=2.14.1 , QuickCheck ^>=2.14.1
, quickcheck-arbitrary-adt ^>=0.3.1.0 , quickcheck-arbitrary-adt ^>=0.3.1.0
, streamly ^>=0.8.2 , streamly ^>=0.8.2
, time ^>=1.9.3 || ^>=1.10 || ^>=1.11
, text ^>=2.0 , text ^>=2.0
, uri-bytestring ^>=0.3.2.2 , uri-bytestring ^>=0.3.2.2
, versions >=4.0.1 && <5.1 , versions >=4.0.1 && <5.1

View File

@ -633,7 +633,9 @@ downloadCached dli mfn = do
True -> downloadCached' dli mfn Nothing True -> downloadCached' dli mfn Nothing
False -> do False -> do
tmp <- lift withGHCupTmpDir tmp <- lift withGHCupTmpDir
liftE $ download (_dlUri dli) Nothing (Just (_dlHash dli)) (_dlCSize dli) (fromGHCupPath tmp) mfn False liftE $ download (_dlUri dli) Nothing (Just (_dlHash dli)) (_dlCSize dli) (fromGHCupPath tmp) outputFileName False
where
outputFileName = mfn <|> _dlOutput dli
downloadCached' :: ( MonadReader env m downloadCached' :: ( MonadReader env m
@ -652,7 +654,7 @@ downloadCached' :: ( MonadReader env m
downloadCached' dli mfn mDestDir = do downloadCached' dli mfn mDestDir = do
Dirs { cacheDir } <- lift getDirs Dirs { cacheDir } <- lift getDirs
let destDir = fromMaybe (fromGHCupPath cacheDir) mDestDir let destDir = fromMaybe (fromGHCupPath cacheDir) mDestDir
let fn = fromMaybe ((T.unpack . decUTF8Safe) $ urlBaseName $ view (dlUri % pathL') dli) mfn let fn = fromMaybe ((T.unpack . decUTF8Safe) $ urlBaseName $ view (dlUri % pathL') dli) outputFileName
let cachfile = destDir </> fn let cachfile = destDir </> fn
fileExists <- liftIO $ doesFileExist cachfile fileExists <- liftIO $ doesFileExist cachfile
if if
@ -660,7 +662,9 @@ downloadCached' dli mfn mDestDir = do
forM_ (view dlCSize dli) $ \s -> liftE $ checkCSize s cachfile forM_ (view dlCSize dli) $ \s -> liftE $ checkCSize s cachfile
liftE $ checkDigest (view dlHash dli) cachfile liftE $ checkDigest (view dlHash dli) cachfile
pure cachfile pure cachfile
| otherwise -> liftE $ download (_dlUri dli) Nothing (Just (_dlHash dli)) (_dlCSize dli) destDir mfn False | otherwise -> liftE $ download (_dlUri dli) Nothing (Just (_dlHash dli)) (_dlCSize dli) destDir outputFileName False
where
outputFileName = mfn <|> _dlOutput dli

View File

@ -38,6 +38,7 @@ import qualified Data.Text as T
import qualified Data.Text.Encoding as E import qualified Data.Text.Encoding as E
import qualified Data.Text.Encoding.Error as E import qualified Data.Text.Encoding.Error as E
import Data.Data (Proxy(..)) import Data.Data (Proxy(..))
import Data.Time (Day)
@ -59,6 +60,7 @@ allHFError = unlines allErrors
, let proxy = Proxy :: Proxy CopyError in format proxy , let proxy = Proxy :: Proxy CopyError in format proxy
, let proxy = Proxy :: Proxy MergeFileTreeError in format proxy , let proxy = Proxy :: Proxy MergeFileTreeError in format proxy
, let proxy = Proxy :: Proxy TagNotFound in format proxy , let proxy = Proxy :: Proxy TagNotFound in format proxy
, let proxy = Proxy :: Proxy DayNotFound in format proxy
, let proxy = Proxy :: Proxy NextVerNotFound in format proxy , let proxy = Proxy :: Proxy NextVerNotFound in format proxy
, let proxy = Proxy :: Proxy AlreadyInstalled in format proxy , let proxy = Proxy :: Proxy AlreadyInstalled in format proxy
, let proxy = Proxy :: Proxy DirNotEmpty in format proxy , let proxy = Proxy :: Proxy DirNotEmpty in format proxy
@ -311,6 +313,21 @@ instance HFErrorProject TagNotFound where
eBase _ = 90 eBase _ = 90
eDesc _ = "Unable to find a tag of a tool" eDesc _ = "Unable to find a tag of a tool"
-- | Unable to find a release day of a tool
data DayNotFound = DayNotFound Day Tool (Maybe Day)
deriving Show
instance Pretty DayNotFound where
pPrint (DayNotFound day tool Nothing) =
text "Unable to find release date" <+> text (show day) <+> text "of tool" <+> pPrint tool
pPrint (DayNotFound day tool (Just alternateDay)) =
text "Unable to find release date" <+> text (show day) <+> text "of tool" <+> pPrint tool <+>
text "but found an alternative date" <+> text (show alternateDay)
instance HFErrorProject DayNotFound where
eBase _ = 95
eDesc _ = "Unable to find a release date of a tool"
-- | Unable to find the next version of a tool (the one after the currently -- | Unable to find the next version of a tool (the one after the currently
-- set one). -- set one).
data NextVerNotFound = NextVerNotFound Tool data NextVerNotFound = NextVerNotFound Tool

View File

@ -36,6 +36,7 @@ import Data.Either
import Data.List import Data.List
import Data.Maybe import Data.Maybe
import Data.Text ( Text ) import Data.Text ( Text )
import Data.Time.Calendar ( Day )
import Data.Versions hiding ( patch ) import Data.Versions hiding ( patch )
import Haskus.Utils.Variant.Excepts import Haskus.Utils.Variant.Excepts
import Optics import Optics
@ -61,9 +62,9 @@ import qualified Data.Text as T
-- | Filter data type for 'listVersions'. -- | Filter data type for 'listVersions'.
data ListCriteria = ListInstalled data ListCriteria = ListInstalled Bool
| ListSet | ListSet Bool
| ListAvailable | ListAvailable Bool
deriving Show deriving Show
-- | A list result describes a single tool version -- | A list result describes a single tool version
@ -79,6 +80,7 @@ data ListResult = ListResult
, lStray :: Bool -- ^ not in download info , lStray :: Bool -- ^ not in download info
, lNoBindist :: Bool -- ^ whether the version is available for this platform/arch , lNoBindist :: Bool -- ^ whether the version is available for this platform/arch
, hlsPowered :: Bool , hlsPowered :: Bool
, lReleaseDay :: Maybe Day
} }
deriving (Eq, Ord, Show) deriving (Eq, Ord, Show)
@ -93,19 +95,22 @@ availableToolVersions av tool = view
-- | List all versions from the download info, as well as stray -- | List all versions from the download info, as well as stray
-- versions. -- versions.
listVersions :: ( MonadCatch m listVersions :: ( MonadCatch m
, HasLog env , HasLog env
, MonadThrow m , MonadThrow m
, HasLog env , HasLog env
, MonadIO m , MonadIO m
, MonadReader env m , MonadReader env m
, HasDirs env , HasDirs env
, HasPlatformReq env , HasPlatformReq env
, HasGHCupInfo env , HasGHCupInfo env
) )
=> Maybe Tool => Maybe Tool
-> Maybe ListCriteria -> [ListCriteria]
-> m [ListResult] -> Bool
listVersions lt' criteria = do -> Bool
-> (Maybe Day, Maybe Day)
-> m [ListResult]
listVersions lt' criteria hideOld showNightly days = do
-- some annoying work to avoid too much repeated IO -- some annoying work to avoid too much repeated IO
cSet <- cabalSet cSet <- cabalSet
cabals <- getInstalledCabals cabals <- getInstalledCabals
@ -172,8 +177,9 @@ listVersions lt' criteria = do
, lCross = Nothing , lCross = Nothing
, lTag = [] , lTag = []
, lInstalled = True , lInstalled = True
, lStray = isNothing (Map.lookup _tvVersion avTools) , lStray = isNothing (Map.lookup _tvVersion avTools)
, lNoBindist = False , lNoBindist = False
, lReleaseDay = Nothing
, .. , ..
} }
Right tver@GHCTargetVersion{ .. } -> do Right tver@GHCTargetVersion{ .. } -> do
@ -188,6 +194,7 @@ listVersions lt' criteria = do
, lInstalled = True , lInstalled = True
, lStray = True -- NOTE: cross currently cannot be installed via bindist , lStray = True -- NOTE: cross currently cannot be installed via bindist
, lNoBindist = False , lNoBindist = False
, lReleaseDay = Nothing
, .. , ..
} }
Left e -> do Left e -> do
@ -223,6 +230,7 @@ listVersions lt' criteria = do
, lNoBindist = False , lNoBindist = False
, fromSrc = False -- actually, we don't know :> , fromSrc = False -- actually, we don't know :>
, hlsPowered = False , hlsPowered = False
, lReleaseDay = Nothing
, .. , ..
} }
Left e -> do Left e -> do
@ -257,6 +265,7 @@ listVersions lt' criteria = do
, lNoBindist = False , lNoBindist = False
, fromSrc = False -- actually, we don't know :> , fromSrc = False -- actually, we don't know :>
, hlsPowered = False , hlsPowered = False
, lReleaseDay = Nothing
, .. , ..
} }
Left e -> do Left e -> do
@ -292,6 +301,7 @@ listVersions lt' criteria = do
, lNoBindist = False , lNoBindist = False
, fromSrc = False -- actually, we don't know :> , fromSrc = False -- actually, we don't know :>
, hlsPowered = False , hlsPowered = False
, lReleaseDay = Nothing
, .. , ..
} }
Left e -> do Left e -> do
@ -317,6 +327,7 @@ listVersions lt' criteria = do
, lInstalled = True , lInstalled = True
, lNoBindist = False , lNoBindist = False
, hlsPowered = False , hlsPowered = False
, lReleaseDay = Nothing
} }
-- NOTE: this are not cross ones, because no bindists -- NOTE: this are not cross ones, because no bindists
@ -337,7 +348,7 @@ listVersions lt' criteria = do
-> [Either FilePath Version] -> [Either FilePath Version]
-> (Version, VersionInfo) -> (Version, VersionInfo)
-> m ListResult -> m ListResult
toListResult t cSet cabals hlsSet' hlses stackSet' stacks (v, _viTags -> tags) = do toListResult t cSet cabals hlsSet' hlses stackSet' stacks (v, VersionInfo{..}) = do
case t of case t of
GHC -> do GHC -> do
lNoBindist <- fmap (isLeft . veitherToEither) $ runE @'[NoDownload] $ getDownloadInfo GHC v lNoBindist <- fmap (isLeft . veitherToEither) $ runE @'[NoDownload] $ getDownloadInfo GHC v
@ -346,31 +357,33 @@ listVersions lt' criteria = do
lInstalled <- ghcInstalled tver lInstalled <- ghcInstalled tver
fromSrc <- ghcSrcInstalled tver fromSrc <- ghcSrcInstalled tver
hlsPowered <- fmap (elem v) hlsGHCVersions hlsPowered <- fmap (elem v) hlsGHCVersions
pure ListResult { lVer = v, lCross = Nothing , lTag = tags, lTool = t, lStray = False, .. } pure ListResult { lVer = v, lCross = Nothing , lTag = _viTags, lTool = t, lStray = False, lReleaseDay = _viReleaseDay, .. }
Cabal -> do Cabal -> do
lNoBindist <- fmap (isLeft . veitherToEither) $ runE @'[NoDownload] $ getDownloadInfo Cabal v lNoBindist <- fmap (isLeft . veitherToEither) $ runE @'[NoDownload] $ getDownloadInfo Cabal v
let lSet = cSet == Just v let lSet = cSet == Just v
let lInstalled = elem v $ rights cabals let lInstalled = elem v $ rights cabals
pure ListResult { lVer = v pure ListResult { lVer = v
, lCross = Nothing , lCross = Nothing
, lTag = tags , lTag = _viTags
, lTool = t , lTool = t
, fromSrc = False , fromSrc = False
, lStray = False , lStray = False
, hlsPowered = False , hlsPowered = False
, lReleaseDay = _viReleaseDay
, .. , ..
} }
GHCup -> do GHCup -> do
let lSet = prettyPVP ghcUpVer == prettyVer v let lSet = prettyPVP ghcUpVer == prettyVer v
let lInstalled = lSet let lInstalled = lSet
pure ListResult { lVer = v pure ListResult { lVer = v
, lTag = tags , lTag = _viTags
, lCross = Nothing , lCross = Nothing
, lTool = t , lTool = t
, fromSrc = False , fromSrc = False
, lStray = False , lStray = False
, lNoBindist = False , lNoBindist = False
, hlsPowered = False , hlsPowered = False
, lReleaseDay = _viReleaseDay
, .. , ..
} }
HLS -> do HLS -> do
@ -379,11 +392,12 @@ listVersions lt' criteria = do
let lInstalled = elem v $ rights hlses let lInstalled = elem v $ rights hlses
pure ListResult { lVer = v pure ListResult { lVer = v
, lCross = Nothing , lCross = Nothing
, lTag = tags , lTag = _viTags
, lTool = t , lTool = t
, fromSrc = False , fromSrc = False
, lStray = False , lStray = False
, hlsPowered = False , hlsPowered = False
, lReleaseDay = _viReleaseDay
, .. , ..
} }
Stack -> do Stack -> do
@ -392,19 +406,43 @@ listVersions lt' criteria = do
let lInstalled = elem v $ rights stacks let lInstalled = elem v $ rights stacks
pure ListResult { lVer = v pure ListResult { lVer = v
, lCross = Nothing , lCross = Nothing
, lTag = tags , lTag = _viTags
, lTool = t , lTool = t
, fromSrc = False , fromSrc = False
, lStray = False , lStray = False
, hlsPowered = False , hlsPowered = False
, lReleaseDay = _viReleaseDay
, .. , ..
} }
filter' :: [ListResult] -> [ListResult] filter' :: [ListResult] -> [ListResult]
filter' lr = case criteria of filter' = filterNightly . filterOld . filter (\lr -> foldr (\a b -> fromCriteria a lr && b) True criteria) . filterDays
Nothing -> lr
Just ListInstalled -> filter (\ListResult {..} -> lInstalled) lr filterDays :: [ListResult] -> [ListResult]
Just ListSet -> filter (\ListResult {..} -> lSet) lr filterDays lrs = case days of
Just ListAvailable -> filter (\ListResult {..} -> not lNoBindist) lr (Nothing, Nothing) -> lrs
(Just from, Just to') -> filter (\ListResult{..} -> maybe False (\d -> d >= from && d <= to') lReleaseDay) lrs
(Nothing, Just to') -> filter (\ListResult{..} -> maybe False (<= to') lReleaseDay) lrs
(Just from, Nothing) -> filter (\ListResult{..} -> maybe False (>= from) lReleaseDay) lrs
fromCriteria :: ListCriteria -> ListResult -> Bool
fromCriteria lc ListResult{..} = case lc of
ListInstalled b -> f b lInstalled
ListSet b -> f b lSet
ListAvailable b -> f b $ not lNoBindist
where
f b
| b = id
| otherwise = not
filterOld :: [ListResult] -> [ListResult]
filterOld lr
| hideOld = filter (\ListResult {..} -> lInstalled || Old `notElem` lTag) lr
| otherwise = lr
filterNightly :: [ListResult] -> [ListResult]
filterNightly lr
| showNightly = lr
| otherwise = filter (\ListResult {..} -> lInstalled || (Nightly `notElem` lTag && LatestNightly `notElem` lTag)) lr

View File

@ -31,6 +31,7 @@ import {-# SOURCE #-} GHCup.Utils.Dirs ( fromGHCupPath, GHCupPath )
import Control.DeepSeq ( NFData, rnf ) import Control.DeepSeq ( NFData, rnf )
import Data.Map.Strict ( Map ) import Data.Map.Strict ( Map )
import Data.List.NonEmpty ( NonEmpty (..) ) import Data.List.NonEmpty ( NonEmpty (..) )
import Data.Time.Calendar ( Day )
import Data.Text ( Text ) import Data.Text ( Text )
import Data.Versions import Data.Versions
import GHC.IO.Exception ( ExitCode ) import GHC.IO.Exception ( ExitCode )
@ -136,6 +137,7 @@ instance NFData GlobalTool
-- source download and per-architecture downloads. -- source download and per-architecture downloads.
data VersionInfo = VersionInfo data VersionInfo = VersionInfo
{ _viTags :: [Tag] -- ^ version specific tag { _viTags :: [Tag] -- ^ version specific tag
, _viReleaseDay :: Maybe Day
, _viChangeLog :: Maybe URI , _viChangeLog :: Maybe URI
, _viSourceDL :: Maybe DownloadInfo -- ^ source tarball , _viSourceDL :: Maybe DownloadInfo -- ^ source tarball
, _viTestDL :: Maybe DownloadInfo -- ^ test tarball , _viTestDL :: Maybe DownloadInfo -- ^ test tarball
@ -155,6 +157,8 @@ data Tag = Latest
| Recommended | Recommended
| Prerelease | Prerelease
| LatestPrerelease | LatestPrerelease
| Nightly
| LatestNightly
| Base PVP | Base PVP
| Old -- ^ old versions are hidden by default in TUI | Old -- ^ old versions are hidden by default in TUI
| UnknownTag String -- ^ used for upwardscompat | UnknownTag String -- ^ used for upwardscompat
@ -166,18 +170,22 @@ tagToString :: Tag -> String
tagToString Recommended = "recommended" tagToString Recommended = "recommended"
tagToString Latest = "latest" tagToString Latest = "latest"
tagToString Prerelease = "prerelease" tagToString Prerelease = "prerelease"
tagToString Nightly = "nightly"
tagToString (Base pvp'') = "base-" ++ T.unpack (prettyPVP pvp'') tagToString (Base pvp'') = "base-" ++ T.unpack (prettyPVP pvp'')
tagToString (UnknownTag t ) = t tagToString (UnknownTag t ) = t
tagToString LatestPrerelease = "latest-prerelease" tagToString LatestPrerelease = "latest-prerelease"
tagToString LatestNightly = "latest-nightly"
tagToString Old = "" tagToString Old = ""
instance Pretty Tag where instance Pretty Tag where
pPrint Recommended = text "recommended" pPrint Recommended = text "recommended"
pPrint Latest = text "latest" pPrint Latest = text "latest"
pPrint Prerelease = text "prerelease" pPrint Prerelease = text "prerelease"
pPrint Nightly = text "nightly"
pPrint (Base pvp'') = text ("base-" ++ T.unpack (prettyPVP pvp'')) pPrint (Base pvp'') = text ("base-" ++ T.unpack (prettyPVP pvp''))
pPrint (UnknownTag t ) = text t pPrint (UnknownTag t ) = text t
pPrint LatestPrerelease = text "latest-prerelease" pPrint LatestPrerelease = text "latest-prerelease"
pPrint LatestNightly = text "latest-prerelease"
pPrint Old = mempty pPrint Old = mempty
data Architecture = A_64 data Architecture = A_64
@ -267,6 +275,7 @@ data DownloadInfo = DownloadInfo
, _dlSubdir :: Maybe TarDir , _dlSubdir :: Maybe TarDir
, _dlHash :: Text , _dlHash :: Text
, _dlCSize :: Maybe Integer , _dlCSize :: Maybe Integer
, _dlOutput :: Maybe FilePath
} }
deriving (Eq, Ord, GHC.Generic, Show) deriving (Eq, Ord, GHC.Generic, Show)
@ -694,3 +703,18 @@ type PromptQuestion = Text
data PromptResponse = PromptYes | PromptNo data PromptResponse = PromptYes | PromptNo
deriving (Show, Eq) deriving (Show, Eq)
data ToolVersion = GHCVersion GHCTargetVersion
| ToolVersion Version
| ToolTag Tag
| ToolDay Day
instance Pretty ToolVersion where
pPrint (GHCVersion v) = pPrint v
pPrint (ToolVersion v) = pPrint v
pPrint (ToolTag t) = pPrint t
pPrint (ToolDay d) = text (show d)

View File

@ -64,9 +64,11 @@ instance ToJSON Tag where
toJSON Latest = String "Latest" toJSON Latest = String "Latest"
toJSON Recommended = String "Recommended" toJSON Recommended = String "Recommended"
toJSON Prerelease = String "Prerelease" toJSON Prerelease = String "Prerelease"
toJSON Nightly = String "Nightly"
toJSON Old = String "old" toJSON Old = String "old"
toJSON (Base pvp'') = String ("base-" <> prettyPVP pvp'') toJSON (Base pvp'') = String ("base-" <> prettyPVP pvp'')
toJSON LatestPrerelease = String "LatestPrerelease" toJSON LatestPrerelease = String "LatestPrerelease"
toJSON LatestNightly = String "LatestNightly"
toJSON (UnknownTag x ) = String (T.pack x) toJSON (UnknownTag x ) = String (T.pack x)
instance FromJSON Tag where instance FromJSON Tag where
@ -74,7 +76,9 @@ instance FromJSON Tag where
"Latest" -> pure Latest "Latest" -> pure Latest
"Recommended" -> pure Recommended "Recommended" -> pure Recommended
"Prerelease" -> pure Prerelease "Prerelease" -> pure Prerelease
"Nightly" -> pure Nightly
"LatestPrerelease" -> pure LatestPrerelease "LatestPrerelease" -> pure LatestPrerelease
"LatestNightly" -> pure LatestNightly
"old" -> pure Old "old" -> pure Old
('b' : 'a' : 's' : 'e' : '-' : ver') -> case pvp (T.pack ver') of ('b' : 'a' : 's' : 'e' : '-' : ver') -> case pvp (T.pack ver') of
Right x -> pure $ Base x Right x -> pure $ Base x

View File

@ -94,6 +94,7 @@ import qualified Streamly.Prelude as S
import Control.DeepSeq (force) import Control.DeepSeq (force)
import GHC.IO (evaluate) import GHC.IO (evaluate)
import System.Environment (getEnvironment, setEnv) import System.Environment (getEnvironment, setEnv)
import Data.Time (Day(..), diffDays, addDays)
-- $setup -- $setup
@ -889,12 +890,30 @@ getTagged tag =
to (Map.toDescList . Map.filter (\VersionInfo {..} -> tag `elem` _viTags)) to (Map.toDescList . Map.filter (\VersionInfo {..} -> tag `elem` _viTags))
% folding id % folding id
getByReleaseDay :: GHCupDownloads -> Tool -> Day -> Either (Maybe Day) (Version, VersionInfo)
getByReleaseDay av tool day = let mvv = fromMaybe mempty $ headOf (ix tool) av
mdv = Map.foldrWithKey (\k vi@VersionInfo{..} m ->
maybe m (\d -> let diff = diffDays d day
in Map.insert (abs diff) (diff, (k, vi)) m) _viReleaseDay)
Map.empty mvv
in case headMay (Map.toAscList mdv) of
Nothing -> Left Nothing
Just (absDiff, (diff, (k, vi)))
| absDiff == 0 -> Right (k, vi)
| otherwise -> Left (Just (addDays diff day))
getByReleaseDayFold :: Day -> Fold (Map.Map Version VersionInfo) (Version, VersionInfo)
getByReleaseDayFold day = to (Map.toDescList . Map.filter (\VersionInfo {..} -> Just day == _viReleaseDay)) % folding id
getLatest :: GHCupDownloads -> Tool -> Maybe (Version, VersionInfo) getLatest :: GHCupDownloads -> Tool -> Maybe (Version, VersionInfo)
getLatest av tool = headOf (ix tool % getTagged Latest) av getLatest av tool = headOf (ix tool % getTagged Latest) av
getLatestPrerelease :: GHCupDownloads -> Tool -> Maybe (Version, VersionInfo) getLatestPrerelease :: GHCupDownloads -> Tool -> Maybe (Version, VersionInfo)
getLatestPrerelease av tool = headOf (ix tool % getTagged LatestPrerelease) av getLatestPrerelease av tool = headOf (ix tool % getTagged LatestPrerelease) av
getLatestNightly :: GHCupDownloads -> Tool -> Maybe (Version, VersionInfo)
getLatestNightly av tool = headOf (ix tool % getTagged LatestNightly) av
getRecommended :: GHCupDownloads -> Tool -> Maybe (Version, VersionInfo) getRecommended :: GHCupDownloads -> Tool -> Maybe (Version, VersionInfo)
getRecommended av tool = headOf (ix tool % getTagged Recommended) av getRecommended av tool = headOf (ix tool % getTagged Recommended) av
@ -1081,11 +1100,15 @@ darwinNotarization _ _ = pure $ Right ()
getChangeLog :: GHCupDownloads -> Tool -> Either Version Tag -> Maybe URI getChangeLog :: GHCupDownloads -> Tool -> ToolVersion -> Maybe URI
getChangeLog dls tool (Left v') = getChangeLog dls tool (GHCVersion (_tvVersion -> v')) =
preview (ix tool % ix v' % viChangeLog % _Just) dls preview (ix tool % ix v' % viChangeLog % _Just) dls
getChangeLog dls tool (Right tag) = getChangeLog dls tool (ToolVersion v') =
preview (ix tool % ix v' % viChangeLog % _Just) dls
getChangeLog dls tool (ToolTag tag) =
preview (ix tool % pre (getTagged tag) % to snd % viChangeLog % _Just) dls preview (ix tool % pre (getTagged tag) % to snd % viChangeLog % _Just) dls
getChangeLog dls tool (ToolDay day) =
preview (ix tool % pre (getByReleaseDayFold day) % to snd % viChangeLog % _Just) dls
-- | Execute a build action while potentially cleaning up: -- | Execute a build action while potentially cleaning up:

View File

@ -1,52 +1,36 @@
resolver: lts-18.28 resolver: lts-20.20
packages: packages:
- . - .
extra-deps: extra-deps:
- Cabal-3.6.2.0@sha256:e2266e14758c1f799220fad7f0d4b0b4ec567d81b7ba3faea17ff76d4c31de95,12437 - Cabal-3.6.3.0
- IfElse-0.85@sha256:6939b94acc6a55f545f63a168a349dd2fbe4b9a7cca73bf60282db5cc6aa47d2,445 - Cabal-syntax-3.10.1.0
- ascii-string-1.0.1.4@sha256:fa34f1d9ba57e8e89c0d4c9cef5e01ba32cb2d4373d13f92dcc0b531a6c6749b,2582 - aeson-2.1.2.1
- base16-bytestring-0.1.1.7@sha256:0021256a9628971c08da95cb8f4d0d72192f3bb8a7b30b55c080562d17c43dd3,2231 - cabal-install-parsers-0.6.1
- brick-0.64@sha256:f03fa14607c22cf48af99e24c44f79a0fb073f7ec229f15e969fed9ff73c93f6,16530
- brotli-0.0.0.0@sha256:2bf383a4cd308745740986be0b18381c5a0784393fe69b91456aacb2d603de46,2964
- brotli-streams-0.0.0.0@sha256:1af1e22f67b8bfd6ad0d05e61825e7a178d738f689ebbb21c1aab5f1bbcae176,2331
- chs-cabal-0.1.1.1 - chs-cabal-0.1.1.1
- chs-deps-0.1.0.0@sha256:0cdada6d2c682c41b20331b8c63c2ecfc7e806928585195fd544c9d41f3074fd,2496 - chs-deps-0.1.0.0
- composition-prelude-3.0.0.2@sha256:1ffed216bd28d810fce0b5be83a661e2a892696d73b3f8de5c0f5edb9b5f0090,1216 - generic-arbitrary-0.2.2@sha256:202ffbf2032672a51318f2e80d7e75b72f8950e690346b4314f38bc7e39215f7,1189
- generically-0.1.1
- haskus-utils-data-1.4@sha256:bfa94363b94b14779edd6834fbd59dbb847c3d7b8f48e3844f456ffdc077da4a,1466 - haskus-utils-data-1.4@sha256:bfa94363b94b14779edd6834fbd59dbb847c3d7b8f48e3844f456ffdc077da4a,1466
- haskus-utils-types-1.5.1@sha256:991c472f4e751e2f0d7aab6ad4220ef151d6160876dcf0511bbf876bbd432020,1298 - haskus-utils-types-1.5.1@sha256:991c472f4e751e2f0d7aab6ad4220ef151d6160876dcf0511bbf876bbd432020,1298
- haskus-utils-variant-3.2.1@sha256:791f4cf1e786eb578f4d37aef60986641f84c36e130164321f7d01542584066a,2200 - haskus-utils-variant-3.2.1
- heaps-0.3.6.1@sha256:7928b759ca5180d35722c45948c0bde264229f3c99c1888188a3d9285f13d3d2,1340 - libarchive-3.0.3.2
- hpath-filepath-0.10.4@sha256:e9e44fb5fdbade7f30b5b5451257dbee15b6ef1aae4060034d73008bb3b5d878,1269
- hpath-posix-0.13.3@sha256:abe472cf16bccd3a8b8814865ed3551a728fde0f3a2baea2acc03023bec6c565,1615
- hspec-2.7.10@sha256:c9e82c90086acebac576552a06f3cabd249bba048edd1667c7fae0b1313d5bce,1712
- hspec-core-2.7.10@sha256:2aba6ea126442b29e8183ab27f1c811706b19b1d83b02f193a896f6fc1589d13,4621
- hspec-discover-2.7.10@sha256:d08bf5dd785629f589571477d9beb7cd91529471bd89f39517c1cb4b9b38160f,2184
- hspec-golden-aeson-0.9.0.0@sha256:aa17274114026661ba4dfc9c60c230673c8f408bd86482fd611d2d5cb6aff996,2179
- http-io-streams-0.1.6.0@sha256:53f5bab177efb52cd65ec396fd04ed59b93e5f919fb3700cd7dacd6cfce6f06d,3582
- libarchive-3.0.3.0
- libyaml-streamly-0.2.1 - libyaml-streamly-0.2.1
- lzma-static-5.2.5.3@sha256:2758ee58c35992fcf7db78e98684c357a16a82fa2a4e7c352a6c210c08c555d8,7308 - lzma-static-5.2.5.5
- optics-0.4@sha256:9fb69bf0195b8d8f1f8cd0098000946868b8a3c3ffb51e5b64f79fc600c3eb4c,6568 - os-release-1.0.2.1
- optics-core-0.4@sha256:59e04aebca536bd011ae50c781937f45af4c1456af1eb9fb578f9a69eee293cd,4995 - parsec-3.1.15.0
- optics-extra-0.4@sha256:b9914f38aa7d5c92f231060d9168447f9f5a367c07df9bf47a003e3e786d5e05,3432
- optics-th-0.4@sha256:7c838b5b1d6998133bf8f0641c36197ed6cb468dc69515e1952f33f0bbe8e11d,2009
- os-release-1.0.1@sha256:1281c62081f438fc3f0874d3bae6a4887d5964ac25261ba06e29d368ab173467,2716
- primitive-0.7.1.0@sha256:29de6bfd0cf8ba023ceb806203dfbec0e51e3524e75ffe41056f70b4229c6f0f,2728
- regex-posix-clib-2.7
- streamly-0.8.2@sha256:ec521b7c1c4db068501c35804af77f40b7d34232f5e29d9b99e722229040eb80,23500 - streamly-0.8.2@sha256:ec521b7c1c4db068501c35804af77f40b7d34232f5e29d9b99e722229040eb80,23500
- unicode-data-0.3.0@sha256:0545e079705a5381d0893f8fe8daaa08fc9174baeab269b9cf651817d8eadbc6,5123 - strict-base-0.4.0.0
- strict-base-0.4.0.0@sha256:2ff4e43cb95eedf2995558d7fc34d19362846413dd39e6aa6a5b3ea8228fef9f,1248 - text-2.0.2
- xor-0.0.1.0@sha256:f8362b4a68562b9afbcd727ff64c1a303970df3a032e0033d2f4c094c3501df3,2243 - yaml-streamly-0.12.2
- yaml-streamly-0.12.1
flags: flags:
http-io-streams: http-io-streams:
brotli: false brotli: false
libarchive: libarchive:
system-libarchive: false system-libarchive: true
regex-posix: regex-posix:
_regex-posix-clib: true _regex-posix-clib: true

View File

@ -11,6 +11,7 @@ import GHCup.Types
import Data.ByteString ( ByteString ) import Data.ByteString ( ByteString )
import Data.Versions import Data.Versions
import Data.List.NonEmpty import Data.List.NonEmpty
import Data.Time.Calendar ( Day(..) )
import Test.QuickCheck import Test.QuickCheck
import Test.QuickCheck.Arbitrary.ADT ( ToADTArbitrary ) import Test.QuickCheck.Arbitrary.ADT ( ToADTArbitrary )
import Test.QuickCheck.Arbitrary.Generic import Test.QuickCheck.Arbitrary.Generic
@ -76,6 +77,9 @@ instance Arbitrary Port where
arbitrary = genericArbitrary arbitrary = genericArbitrary
shrink = genericShrink shrink = genericShrink
instance Arbitrary Day where
arbitrary = ModifiedJulianDay . fromIntegral <$> (chooseAny :: Gen Int)
instance Arbitrary (URIRef Absolute) where instance Arbitrary (URIRef Absolute) where
arbitrary = arbitrary =
URI <$> arbitrary <*> pure Nothing <*> arbitrary <*> pure (Query []) <*> pure Nothing URI <$> arbitrary <*> pure Nothing <*> arbitrary <*> pure (Query []) <*> pure Nothing

File diff suppressed because it is too large Load Diff

File diff suppressed because it is too large Load Diff