Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Make --tool and --show-criteria 'many' #1238

Open
wants to merge 1 commit into
base: master
Choose a base branch
from
Open

Make --tool and --show-criteria 'many' #1238

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
4 changes: 2 additions & 2 deletions lib-opt/GHCup/OptParse/Common.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -322,7 +322,7 @@ versionCompleter' criteria tool filter' = listIOCompleter $ do

runEnv = flip runReaderT appState

installedVersions <- runEnv $ listVersions (Just tool) criteria False False (Nothing, Nothing)
installedVersions <- runEnv $ listVersions [tool] criteria False False (Nothing, Nothing)
return $ fmap (T.unpack . prettyVer) . filter filter' . fmap lVer $ installedVersions


Expand Down Expand Up @@ -481,7 +481,7 @@ checkForUpdates :: ( MonadReader env m
=> m [(Tool, GHCTargetVersion)]
checkForUpdates = do
GHCupInfo { _ghcupDownloads = dls } <- getGHCupInfo
lInstalled <- listVersions Nothing [ListInstalled True] False False (Nothing, Nothing)
lInstalled <- listVersions [] [ListInstalled True] False False (Nothing, Nothing)
let latestInstalled tool = (fmap (\lr -> GHCTargetVersion (lCross lr) (lVer lr)) . lastMay . filter (\lr -> lTool lr == tool)) lInstalled

ghcup <- forMM (getLatest dls GHCup) $ \(GHCTargetVersion _ l, _) -> do
Expand Down
12 changes: 6 additions & 6 deletions lib-opt/GHCup/OptParse/List.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -55,8 +55,8 @@ import GHCup.Prelude.Logger (logDebug)


data ListOptions = ListOptions
{ loTool :: Maybe Tool
, lCriteria :: Maybe ListCriteria
{ loTool :: [Tool]
, lCriteria :: [ListCriteria]
, lFrom :: Maybe Day
, lTo :: Maybe Day
, lHideOld :: Bool
Expand All @@ -74,15 +74,15 @@ data ListOptions = ListOptions
listOpts :: Parser ListOptions
listOpts =
ListOptions
<$> optional
<$> many
(option
(eitherReader toolParser)
(short 't' <> long "tool" <> metavar "<ghc|cabal|hls|stack>" <> help
(short 't' <> long "tool" <> metavar "<ghc|cabal|hls|stack|ghcup>" <> help
"Tool to list versions for. Default is all"
<> completer toolCompleter
)
)
<*> optional
<*> many
(option
(eitherReader criteriaParser)
( short 'c'
Expand Down Expand Up @@ -238,7 +238,7 @@ list :: ( Monad m
-> m ExitCode
list ListOptions{..} no_color pgc runAppState =
runAppState (do
l <- listVersions loTool (maybeToList lCriteria) lHideOld lShowNightly (lFrom, lTo)
l <- listVersions loTool lCriteria lHideOld lShowNightly (lFrom, lTo)
printListResult no_color pgc lRawFormat l
pure ExitSuccess
)
2 changes: 1 addition & 1 deletion lib-opt/GHCup/OptParse/Nuke.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -78,7 +78,7 @@ nuke appState runLogger = do
lift $ logInfo "Initiating Nuclear Sequence 🚀🚀🚀"
lift $ logInfo "Nuking in 3...2...1"

lInstalled <- lift $ listVersions Nothing [ListInstalled True] False True (Nothing, Nothing)
lInstalled <- lift $ listVersions [] [ListInstalled True] False True (Nothing, Nothing)

forM_ lInstalled (liftE . rmTool)

Expand Down
2 changes: 1 addition & 1 deletion lib-tui/GHCup/Brick/Actions.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -702,7 +702,7 @@ getAppData mgi = runExceptT $ do
settings <- liftIO $ readIORef settings'

flip runReaderT settings $ do
lV <- listVersions Nothing [] False True (Nothing, Nothing)
lV <- listVersions [] [] False True (Nothing, Nothing)
pure $ BrickData (reverse lV)

--
Expand Down
2 changes: 1 addition & 1 deletion lib/GHCup.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -557,7 +557,7 @@ rmUnsetTools :: ( MonadReader env m
)
=> Excepts '[NotInstalled, UninstallFailed] m ()
rmUnsetTools = do
vers <- lift $ listVersions Nothing [ListInstalled True, ListSet False] False True (Nothing, Nothing)
vers <- lift $ listVersions [] [ListInstalled True, ListSet False] False True (Nothing, Nothing)
forM_ vers $ \ListResult{..} -> case lTool of
GHC -> liftE $ rmGHCVer (GHCTargetVersion lCross lVer)
HLS -> liftE $ rmHLSVer lVer
Expand Down
30 changes: 12 additions & 18 deletions lib/GHCup/List.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -103,7 +103,7 @@ listVersions :: ( MonadCatch m
, HasPlatformReq env
, HasGHCupInfo env
)
=> Maybe Tool
=> [Tool]
-> [ListCriteria]
-> Bool
-> Bool
Expand All @@ -119,17 +119,16 @@ listVersions lt' criteria hideOld showNightly days = do
stacks <- getInstalledStacks
hlsGHCVs <- fmap mkTVer <$> hlsGHCVersions

go lt' hlsGHCVs cSet cabals hlsSet' hlses sSet stacks
go (if null lt' then [GHC, Cabal, HLS, Stack, GHCup] else lt') hlsGHCVs cSet cabals hlsSet' hlses sSet stacks
where
go lt hlsGHCVs cSet cabals hlsSet' hlses sSet stacks = do
case lt of
Just t -> do
GHCupInfo { _ghcupDownloads = dls } <- getGHCupInfo
-- get versions from GHCupDownloads
let avTools = availableToolVersions dls t
lr <- filter' <$> forM (Map.toList avTools) (toListResult t hlsGHCVs cSet cabals hlsSet' hlses sSet stacks)

case t of
go [] _hlsGHCVs _cSet _cabals _hlsSet' _hlses _sSet _stacks = pure []
go (lt:lts) hlsGHCVs cSet cabals hlsSet' hlses sSet stacks = do
GHCupInfo { _ghcupDownloads = dls } <- getGHCupInfo
-- get versions from GHCupDownloads
let avTools = availableToolVersions dls lt
lr <- filter' <$> forM (Map.toList avTools) (toListResult lt hlsGHCVs cSet cabals hlsSet' hlses sSet stacks)

r <- case lt of
GHC -> do
slr <- strayGHCs avTools
pure (sort (slr ++ lr))
Expand All @@ -145,13 +144,8 @@ listVersions lt' criteria hideOld showNightly days = do
GHCup -> do
let cg = maybeToList $ currentGHCup avTools
pure (sort (cg ++ lr))
Nothing -> do
ghcvers <- go (Just GHC) hlsGHCVs cSet cabals hlsSet' hlses sSet stacks
cabalvers <- go (Just Cabal) hlsGHCVs cSet cabals hlsSet' hlses sSet stacks
hlsvers <- go (Just HLS) hlsGHCVs cSet cabals hlsSet' hlses sSet stacks
ghcupvers <- go (Just GHCup) hlsGHCVs cSet cabals hlsSet' hlses sSet stacks
stackvers <- go (Just Stack) hlsGHCVs cSet cabals hlsSet' hlses sSet stacks
pure (ghcvers <> cabalvers <> hlsvers <> stackvers <> ghcupvers)
rn <- go lts hlsGHCVs cSet cabals hlsSet' hlses sSet stacks
pure (r <> rn)
strayGHCs :: ( MonadCatch m
, MonadReader env m
, HasDirs env
Expand Down
1 change: 1 addition & 0 deletions lib/GHCup/Utils/Parsers.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -174,6 +174,7 @@ toolParser s' | t == T.pack "ghc" = Right GHC
| t == T.pack "cabal" = Right Cabal
| t == T.pack "hls" = Right HLS
| t == T.pack "stack" = Right Stack
| t == T.pack "ghcup" = Right GHCup
| otherwise = Left ("Unknown tool: " <> s')
where t = T.toLower (T.pack s')

Expand Down
28 changes: 14 additions & 14 deletions test/optparse-test/ListTest.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -11,24 +11,24 @@ listTests :: TestTree
listTests = buildTestTree listParseWith ("list", listCheckList)

defaultOptions :: ListOptions
defaultOptions = ListOptions Nothing Nothing Nothing Nothing False False False
defaultOptions = ListOptions [] [] Nothing Nothing False False False

listCheckList :: [(String, ListOptions)]
listCheckList =
[ ("list", defaultOptions)
, ("list -t ghc", defaultOptions{loTool = Just GHC})
, ("list -t cabal", defaultOptions{loTool = Just Cabal})
, ("list -t hls", defaultOptions{loTool = Just HLS})
, ("list -t stack", defaultOptions{loTool = Just Stack})
, ("list -c installed", defaultOptions{lCriteria = Just $ ListInstalled True})
, ("list -c +installed", defaultOptions{lCriteria = Just $ ListInstalled True})
, ("list -c -installed", defaultOptions{lCriteria = Just $ ListInstalled False})
, ("list -c set", defaultOptions{lCriteria = Just $ ListSet True})
, ("list -c +set", defaultOptions{lCriteria = Just $ ListSet True})
, ("list -c -set", defaultOptions{lCriteria = Just $ ListSet False})
, ("list -c available", defaultOptions{lCriteria = Just $ ListAvailable True})
, ("list -c +available", defaultOptions{lCriteria = Just $ ListAvailable True})
, ("list -c -available", defaultOptions{lCriteria = Just $ ListAvailable False})
, ("list -t ghc", defaultOptions{loTool = [GHC]})
, ("list -t cabal", defaultOptions{loTool = [Cabal]})
, ("list -t hls", defaultOptions{loTool = [HLS]})
, ("list -t stack", defaultOptions{loTool = [Stack]})
, ("list -c installed", defaultOptions{lCriteria = [ListInstalled True]})
, ("list -c +installed", defaultOptions{lCriteria = [ListInstalled True]})
, ("list -c -installed", defaultOptions{lCriteria = [ListInstalled False]})
, ("list -c set", defaultOptions{lCriteria = [ListSet True]})
, ("list -c +set", defaultOptions{lCriteria = [ListSet True]})
, ("list -c -set", defaultOptions{lCriteria = [ListSet False]})
, ("list -c available", defaultOptions{lCriteria = [ListAvailable True]})
, ("list -c +available", defaultOptions{lCriteria = [ListAvailable True]})
, ("list -c -available", defaultOptions{lCriteria = [ListAvailable False]})
, ("list -s 2023-07-22", defaultOptions{lFrom = Just $ read "2023-07-22"})
, ("list -u 2023-07-22", defaultOptions{lTo = Just $ read "2023-07-22"})
, ("list --since 2023-07-22 --until 2023-07-22", defaultOptions{lFrom = Just $ read "2023-07-22", lTo = Just $ read "2023-07-22"})
Expand Down
Loading