Implement support for nightlies, wrt #824

This commit is contained in:
Julian Ospald 2023-05-01 17:46:27 +08:00
parent 1ba2361fea
commit 4b34cddcda
No known key found for this signature in database
GPG Key ID: CCC85C0E40C06A8C
26 changed files with 11395 additions and 10427 deletions

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

@ -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
@ -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,15 @@ 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 <$> getByReleaseDay dls tool day ?? DayNotFound day tool
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 +800,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

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
] ]

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

View File

@ -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
, 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
, 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

@ -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,18 @@ 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
deriving Show
instance Pretty DayNotFound where
pPrint (DayNotFound day tool) =
text "Unable to find release date" <+> text (show day) <+> text "of tool" <+> pPrint tool
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
@ -694,3 +702,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)
-- $setup -- $setup
@ -889,12 +890,21 @@ 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 -> Maybe (Version, VersionInfo)
getByReleaseDay av tool day = headOf (ix tool % getByReleaseDayFold day) av
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 +1091,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

@ -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

View File

@ -274,6 +274,7 @@
"viPostInstall": "voj", "viPostInstall": "voj",
"viPostRemove": null, "viPostRemove": null,
"viPreCompile": "yma", "viPreCompile": "yma",
"viReleaseDay": null,
"viSourceDL": { "viSourceDL": {
"dlCSize": null, "dlCSize": null,
"dlHash": "wv", "dlHash": "wv",
@ -377,6 +378,7 @@
"viPostInstall": "drbiff", "viPostInstall": "drbiff",
"viPostRemove": "lk", "viPostRemove": "lk",
"viPreCompile": "thzbtj", "viPreCompile": "thzbtj",
"viReleaseDay": null,
"viSourceDL": { "viSourceDL": {
"dlCSize": null, "dlCSize": null,
"dlHash": "jpouxbme", "dlHash": "jpouxbme",
@ -500,6 +502,7 @@
"viPostInstall": "uogkghr", "viPostInstall": "uogkghr",
"viPostRemove": null, "viPostRemove": null,
"viPreCompile": "nmkj", "viPreCompile": "nmkj",
"viReleaseDay": null,
"viSourceDL": { "viSourceDL": {
"dlCSize": null, "dlCSize": null,
"dlHash": "d", "dlHash": "d",
@ -816,6 +819,7 @@
"viPostInstall": "pvhnmsmi", "viPostInstall": "pvhnmsmi",
"viPostRemove": "jkc", "viPostRemove": "jkc",
"viPreCompile": "y", "viPreCompile": "y",
"viReleaseDay": null,
"viSourceDL": { "viSourceDL": {
"dlCSize": null, "dlCSize": null,
"dlHash": "edqa", "dlHash": "edqa",
@ -1081,6 +1085,7 @@
"viPostInstall": "", "viPostInstall": "",
"viPostRemove": null, "viPostRemove": null,
"viPreCompile": "hnakh", "viPreCompile": "hnakh",
"viReleaseDay": null,
"viSourceDL": null, "viSourceDL": null,
"viTags": [ "viTags": [
"base-7.3.6", "base-7.3.6",
@ -1236,6 +1241,7 @@
"viPostInstall": "dwizoud", "viPostInstall": "dwizoud",
"viPostRemove": "foi", "viPostRemove": "foi",
"viPreCompile": "ma", "viPreCompile": "ma",
"viReleaseDay": null,
"viSourceDL": { "viSourceDL": {
"dlCSize": null, "dlCSize": null,
"dlHash": "lpc", "dlHash": "lpc",
@ -1668,6 +1674,7 @@
"viPostInstall": "anwu", "viPostInstall": "anwu",
"viPostRemove": null, "viPostRemove": null,
"viPreCompile": "uavccmoo", "viPreCompile": "uavccmoo",
"viReleaseDay": null,
"viSourceDL": { "viSourceDL": {
"dlCSize": null, "dlCSize": null,
"dlHash": "wp", "dlHash": "wp",
@ -1965,6 +1972,7 @@
"viPostInstall": "mddazr", "viPostInstall": "mddazr",
"viPostRemove": "bltge", "viPostRemove": "bltge",
"viPreCompile": "khe", "viPreCompile": "khe",
"viReleaseDay": null,
"viSourceDL": { "viSourceDL": {
"dlCSize": null, "dlCSize": null,
"dlHash": "ovmjwp", "dlHash": "ovmjwp",
@ -2302,6 +2310,7 @@
"viPostInstall": "egwp", "viPostInstall": "egwp",
"viPostRemove": "vn", "viPostRemove": "vn",
"viPreCompile": "crsegnwv", "viPreCompile": "crsegnwv",
"viReleaseDay": null,
"viSourceDL": { "viSourceDL": {
"dlCSize": null, "dlCSize": null,
"dlHash": "gizfs", "dlHash": "gizfs",
@ -2426,6 +2435,7 @@
"viPostInstall": "hqpy", "viPostInstall": "hqpy",
"viPostRemove": "vbupaa", "viPostRemove": "vbupaa",
"viPreCompile": "lu", "viPreCompile": "lu",
"viReleaseDay": null,
"viSourceDL": { "viSourceDL": {
"dlCSize": null, "dlCSize": null,
"dlHash": "l", "dlHash": "l",
@ -2882,6 +2892,7 @@
"viPostInstall": null, "viPostInstall": null,
"viPostRemove": "jpehk", "viPostRemove": "jpehk",
"viPreCompile": "ucz", "viPreCompile": "ucz",
"viReleaseDay": null,
"viSourceDL": { "viSourceDL": {
"dlCSize": null, "dlCSize": null,
"dlHash": "nryawf", "dlHash": "nryawf",
@ -3097,6 +3108,7 @@
"viPostInstall": "nvs", "viPostInstall": "nvs",
"viPostRemove": null, "viPostRemove": null,
"viPreCompile": null, "viPreCompile": null,
"viReleaseDay": null,
"viSourceDL": { "viSourceDL": {
"dlCSize": null, "dlCSize": null,
"dlHash": "n", "dlHash": "n",
@ -3329,6 +3341,7 @@
"viPostInstall": "vouuw", "viPostInstall": "vouuw",
"viPostRemove": "widnqidl", "viPostRemove": "widnqidl",
"viPreCompile": "hdykow", "viPreCompile": "hdykow",
"viReleaseDay": null,
"viSourceDL": { "viSourceDL": {
"dlCSize": null, "dlCSize": null,
"dlHash": "in", "dlHash": "in",
@ -3688,6 +3701,7 @@
"viPostInstall": null, "viPostInstall": null,
"viPostRemove": "vhzr", "viPostRemove": "vhzr",
"viPreCompile": null, "viPreCompile": null,
"viReleaseDay": null,
"viSourceDL": { "viSourceDL": {
"dlCSize": null, "dlCSize": null,
"dlHash": "ooajpjt", "dlHash": "ooajpjt",
@ -3755,6 +3769,7 @@
"viPostInstall": "z", "viPostInstall": "z",
"viPostRemove": null, "viPostRemove": null,
"viPreCompile": null, "viPreCompile": null,
"viReleaseDay": null,
"viSourceDL": null, "viSourceDL": null,
"viTags": [ "viTags": [
"base-2.6.5", "base-2.6.5",
@ -3886,6 +3901,7 @@
"viPostInstall": "", "viPostInstall": "",
"viPostRemove": "o", "viPostRemove": "o",
"viPreCompile": "vfij", "viPreCompile": "vfij",
"viReleaseDay": null,
"viSourceDL": null, "viSourceDL": null,
"viTags": [ "viTags": [
"base-5.4.2", "base-5.4.2",
@ -4006,6 +4022,7 @@
"viPostInstall": "ezahxgy", "viPostInstall": "ezahxgy",
"viPostRemove": "", "viPostRemove": "",
"viPreCompile": null, "viPreCompile": null,
"viReleaseDay": null,
"viSourceDL": null, "viSourceDL": null,
"viTags": [ "viTags": [
"old" "old"
@ -4192,6 +4209,7 @@
"viPostInstall": "qrvyqt", "viPostInstall": "qrvyqt",
"viPostRemove": null, "viPostRemove": null,
"viPreCompile": null, "viPreCompile": null,
"viReleaseDay": null,
"viSourceDL": null, "viSourceDL": null,
"viTags": [ "viTags": [
"Latest", "Latest",
@ -4471,6 +4489,7 @@
"viPostInstall": "rialloi", "viPostInstall": "rialloi",
"viPostRemove": "hsul", "viPostRemove": "hsul",
"viPreCompile": null, "viPreCompile": null,
"viReleaseDay": null,
"viSourceDL": null, "viSourceDL": null,
"viTags": [ "viTags": [
"鲤" "鲤"
@ -4832,6 +4851,7 @@
"viPostInstall": "nr", "viPostInstall": "nr",
"viPostRemove": null, "viPostRemove": null,
"viPreCompile": null, "viPreCompile": null,
"viReleaseDay": null,
"viSourceDL": { "viSourceDL": {
"dlCSize": null, "dlCSize": null,
"dlHash": "pd", "dlHash": "pd",
@ -4948,6 +4968,7 @@
"viPostInstall": "avh", "viPostInstall": "avh",
"viPostRemove": "eegqaxeq", "viPostRemove": "eegqaxeq",
"viPreCompile": "cyrqrsay", "viPreCompile": "cyrqrsay",
"viReleaseDay": null,
"viSourceDL": null, "viSourceDL": null,
"viTags": [ "viTags": [
"Latest", "Latest",
@ -5036,6 +5057,7 @@
"viPostInstall": null, "viPostInstall": null,
"viPostRemove": null, "viPostRemove": null,
"viPreCompile": null, "viPreCompile": null,
"viReleaseDay": null,
"viSourceDL": { "viSourceDL": {
"dlCSize": null, "dlCSize": null,
"dlHash": "p", "dlHash": "p",
@ -5131,6 +5153,7 @@
"viPostInstall": "k", "viPostInstall": "k",
"viPostRemove": "dxqp", "viPostRemove": "dxqp",
"viPreCompile": "fzrbyso", "viPreCompile": "fzrbyso",
"viReleaseDay": null,
"viSourceDL": { "viSourceDL": {
"dlCSize": null, "dlCSize": null,
"dlHash": "sx", "dlHash": "sx",
@ -5483,6 +5506,7 @@
"viPostInstall": "m", "viPostInstall": "m",
"viPostRemove": "nwnzw", "viPostRemove": "nwnzw",
"viPreCompile": "s", "viPreCompile": "s",
"viReleaseDay": null,
"viSourceDL": { "viSourceDL": {
"dlCSize": null, "dlCSize": null,
"dlHash": "dinptoca", "dlHash": "dinptoca",
@ -5566,6 +5590,7 @@
"viPostInstall": "bquxgn", "viPostInstall": "bquxgn",
"viPostRemove": null, "viPostRemove": null,
"viPreCompile": "rtzhvw", "viPreCompile": "rtzhvw",
"viReleaseDay": null,
"viSourceDL": { "viSourceDL": {
"dlCSize": null, "dlCSize": null,
"dlHash": "xs", "dlHash": "xs",
@ -5678,6 +5703,7 @@
"viPostInstall": "bxdutem", "viPostInstall": "bxdutem",
"viPostRemove": null, "viPostRemove": null,
"viPreCompile": "dl", "viPreCompile": "dl",
"viReleaseDay": null,
"viSourceDL": { "viSourceDL": {
"dlCSize": null, "dlCSize": null,
"dlHash": "uvy", "dlHash": "uvy",
@ -6083,6 +6109,7 @@
"viPostInstall": "ocvjmosz", "viPostInstall": "ocvjmosz",
"viPostRemove": "b", "viPostRemove": "b",
"viPreCompile": null, "viPreCompile": null,
"viReleaseDay": null,
"viSourceDL": { "viSourceDL": {
"dlCSize": null, "dlCSize": null,
"dlHash": "jo", "dlHash": "jo",
@ -7368,6 +7395,7 @@
"viPostInstall": null, "viPostInstall": null,
"viPostRemove": null, "viPostRemove": null,
"viPreCompile": "rkmaobn", "viPreCompile": "rkmaobn",
"viReleaseDay": null,
"viSourceDL": { "viSourceDL": {
"dlCSize": null, "dlCSize": null,
"dlHash": "gbhvafgn", "dlHash": "gbhvafgn",
@ -8066,6 +8094,7 @@
"viPostInstall": null, "viPostInstall": null,
"viPostRemove": "hdst", "viPostRemove": "hdst",
"viPreCompile": "lssslq", "viPreCompile": "lssslq",
"viReleaseDay": null,
"viSourceDL": null, "viSourceDL": null,
"viTags": [ "viTags": [
"", "",
@ -8345,6 +8374,7 @@
"viPostInstall": null, "viPostInstall": null,
"viPostRemove": "lp", "viPostRemove": "lp",
"viPreCompile": "orlne", "viPreCompile": "orlne",
"viReleaseDay": null,
"viSourceDL": { "viSourceDL": {
"dlCSize": null, "dlCSize": null,
"dlHash": "wehnncsi", "dlHash": "wehnncsi",
@ -8542,6 +8572,7 @@
"viPostInstall": "izvcv", "viPostInstall": "izvcv",
"viPostRemove": "byey", "viPostRemove": "byey",
"viPreCompile": "lbl", "viPreCompile": "lbl",
"viReleaseDay": null,
"viSourceDL": { "viSourceDL": {
"dlCSize": null, "dlCSize": null,
"dlHash": "jqlydnm", "dlHash": "jqlydnm",
@ -8568,6 +8599,7 @@
"viPostInstall": "oyil", "viPostInstall": "oyil",
"viPostRemove": "sirzxo", "viPostRemove": "sirzxo",
"viPreCompile": "hecmex", "viPreCompile": "hecmex",
"viReleaseDay": null,
"viSourceDL": { "viSourceDL": {
"dlCSize": null, "dlCSize": null,
"dlHash": "n", "dlHash": "n",
@ -8915,6 +8947,7 @@
"viPostInstall": null, "viPostInstall": null,
"viPostRemove": "pdwctmw", "viPostRemove": "pdwctmw",
"viPreCompile": "apqewk", "viPreCompile": "apqewk",
"viReleaseDay": null,
"viSourceDL": { "viSourceDL": {
"dlCSize": null, "dlCSize": null,
"dlHash": "xgebbvvt", "dlHash": "xgebbvvt",
@ -9056,6 +9089,7 @@
"viPostInstall": "qecgd", "viPostInstall": "qecgd",
"viPostRemove": "zzuiq", "viPostRemove": "zzuiq",
"viPreCompile": "jwqv", "viPreCompile": "jwqv",
"viReleaseDay": null,
"viSourceDL": { "viSourceDL": {
"dlCSize": null, "dlCSize": null,
"dlHash": "uhqdcf", "dlHash": "uhqdcf",
@ -10431,6 +10465,7 @@
"viPostInstall": null, "viPostInstall": null,
"viPostRemove": "inqxrwxs", "viPostRemove": "inqxrwxs",
"viPreCompile": "deajwn", "viPreCompile": "deajwn",
"viReleaseDay": null,
"viSourceDL": { "viSourceDL": {
"dlCSize": null, "dlCSize": null,
"dlHash": "xhkk", "dlHash": "xhkk",
@ -10754,6 +10789,7 @@
"viPostInstall": "rvzk", "viPostInstall": "rvzk",
"viPostRemove": "r", "viPostRemove": "r",
"viPreCompile": "", "viPreCompile": "",
"viReleaseDay": null,
"viSourceDL": null, "viSourceDL": null,
"viTags": [ "viTags": [
"base-5.1.7", "base-5.1.7",
@ -11130,6 +11166,7 @@
"viPostInstall": "jrkzdq", "viPostInstall": "jrkzdq",
"viPostRemove": "p", "viPostRemove": "p",
"viPreCompile": "", "viPreCompile": "",
"viReleaseDay": null,
"viSourceDL": { "viSourceDL": {
"dlCSize": null, "dlCSize": null,
"dlHash": "fi", "dlHash": "fi",
@ -11376,6 +11413,7 @@
"viPostInstall": null, "viPostInstall": null,
"viPostRemove": "hcftjbb", "viPostRemove": "hcftjbb",
"viPreCompile": "qy", "viPreCompile": "qy",
"viReleaseDay": null,
"viSourceDL": null, "viSourceDL": null,
"viTags": [ "viTags": [
"\u000c󴶑\u0001E\u0012\u0015", "\u000c󴶑\u0001E\u0012\u0015",
@ -11394,6 +11432,7 @@
"viPostInstall": "", "viPostInstall": "",
"viPostRemove": null, "viPostRemove": null,
"viPreCompile": "hr", "viPreCompile": "hr",
"viReleaseDay": null,
"viSourceDL": { "viSourceDL": {
"dlCSize": null, "dlCSize": null,
"dlHash": "pd", "dlHash": "pd",
@ -11414,6 +11453,7 @@
"viPostInstall": null, "viPostInstall": null,
"viPostRemove": "nhlcatpc", "viPostRemove": "nhlcatpc",
"viPreCompile": "wjakrdnl", "viPreCompile": "wjakrdnl",
"viReleaseDay": null,
"viSourceDL": { "viSourceDL": {
"dlCSize": null, "dlCSize": null,
"dlHash": "rx", "dlHash": "rx",
@ -11796,6 +11836,7 @@
"viPostInstall": "cey", "viPostInstall": "cey",
"viPostRemove": "bbuscyjp", "viPostRemove": "bbuscyjp",
"viPreCompile": "fvw", "viPreCompile": "fvw",
"viReleaseDay": null,
"viSourceDL": { "viSourceDL": {
"dlCSize": null, "dlCSize": null,
"dlHash": "zeqioqpo", "dlHash": "zeqioqpo",
@ -13572,6 +13613,7 @@
"viPostInstall": "jdjwlz", "viPostInstall": "jdjwlz",
"viPostRemove": "fbzect", "viPostRemove": "fbzect",
"viPreCompile": null, "viPreCompile": null,
"viReleaseDay": null,
"viSourceDL": { "viSourceDL": {
"dlCSize": null, "dlCSize": null,
"dlHash": "woix", "dlHash": "woix",
@ -13624,6 +13666,7 @@
"viPostInstall": null, "viPostInstall": null,
"viPostRemove": null, "viPostRemove": null,
"viPreCompile": "dxw", "viPreCompile": "dxw",
"viReleaseDay": null,
"viSourceDL": null, "viSourceDL": null,
"viTags": [ "viTags": [
"Latest" "Latest"
@ -13638,6 +13681,7 @@
"viPostInstall": "ly", "viPostInstall": "ly",
"viPostRemove": null, "viPostRemove": null,
"viPreCompile": "unrj", "viPreCompile": "unrj",
"viReleaseDay": null,
"viSourceDL": { "viSourceDL": {
"dlCSize": null, "dlCSize": null,
"dlHash": "h", "dlHash": "h",
@ -14092,6 +14136,7 @@
"viPostInstall": "ytr", "viPostInstall": "ytr",
"viPostRemove": null, "viPostRemove": null,
"viPreCompile": null, "viPreCompile": null,
"viReleaseDay": null,
"viSourceDL": { "viSourceDL": {
"dlCSize": null, "dlCSize": null,
"dlHash": "", "dlHash": "",
@ -14281,6 +14326,7 @@
"viPostInstall": "qvm", "viPostInstall": "qvm",
"viPostRemove": "sgvk", "viPostRemove": "sgvk",
"viPreCompile": "nvecnkvu", "viPreCompile": "nvecnkvu",
"viReleaseDay": null,
"viSourceDL": { "viSourceDL": {
"dlCSize": null, "dlCSize": null,
"dlHash": "dzydyxg", "dlHash": "dzydyxg",
@ -14346,6 +14392,7 @@
"viPostInstall": "segjmze", "viPostInstall": "segjmze",
"viPostRemove": "", "viPostRemove": "",
"viPreCompile": null, "viPreCompile": null,
"viReleaseDay": null,
"viSourceDL": { "viSourceDL": {
"dlCSize": null, "dlCSize": null,
"dlHash": "nu", "dlHash": "nu",
@ -14495,6 +14542,7 @@
"viPostInstall": "kvdlwtq", "viPostInstall": "kvdlwtq",
"viPostRemove": "qyvxvztp", "viPostRemove": "qyvxvztp",
"viPreCompile": "hpjrxowq", "viPreCompile": "hpjrxowq",
"viReleaseDay": null,
"viSourceDL": { "viSourceDL": {
"dlCSize": null, "dlCSize": null,
"dlHash": "uvyqgeiy", "dlHash": "uvyqgeiy",
@ -14667,6 +14715,7 @@
"viPostInstall": "hqxhqabh", "viPostInstall": "hqxhqabh",
"viPostRemove": "h", "viPostRemove": "h",
"viPreCompile": "", "viPreCompile": "",
"viReleaseDay": null,
"viSourceDL": { "viSourceDL": {
"dlCSize": null, "dlCSize": null,
"dlHash": "mpfno", "dlHash": "mpfno",
@ -14864,6 +14913,7 @@
"viPostInstall": null, "viPostInstall": null,
"viPostRemove": "h", "viPostRemove": "h",
"viPreCompile": null, "viPreCompile": null,
"viReleaseDay": null,
"viSourceDL": { "viSourceDL": {
"dlCSize": null, "dlCSize": null,
"dlHash": "pazpsu", "dlHash": "pazpsu",
@ -15204,6 +15254,7 @@
"viPostInstall": "uvftr", "viPostInstall": "uvftr",
"viPostRemove": "", "viPostRemove": "",
"viPreCompile": null, "viPreCompile": null,
"viReleaseDay": null,
"viSourceDL": { "viSourceDL": {
"dlCSize": null, "dlCSize": null,
"dlHash": "orhgsp", "dlHash": "orhgsp",
@ -15565,6 +15616,7 @@
"viPostInstall": "js", "viPostInstall": "js",
"viPostRemove": "mjwcdv", "viPostRemove": "mjwcdv",
"viPreCompile": null, "viPreCompile": null,
"viReleaseDay": null,
"viSourceDL": { "viSourceDL": {
"dlCSize": null, "dlCSize": null,
"dlHash": "poxbrll", "dlHash": "poxbrll",

File diff suppressed because it is too large Load Diff