Skip to content

Commit 314a93b

Browse files
hasufellhasufell
committed
Make --tool and --show-criteria 'many'
Fixes #1235
1 parent 532234b commit 314a93b

File tree

8 files changed

+38
-43
lines changed

8 files changed

+38
-43
lines changed

‎lib-opt/GHCup/OptParse/Common.hs‎

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -322,7 +322,7 @@ versionCompleter' criteria tool filter' = listIOCompleter $ do
322322

323323
runEnv = flip runReaderT appState
324324

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

328328

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

487487
ghcup <- forMM (getLatest dls GHCup) $ \(GHCTargetVersion _ l, _) -> do

‎lib-opt/GHCup/OptParse/List.hs‎

Lines changed: 6 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -55,8 +55,8 @@ import GHCup.Prelude.Logger (logDebug)
5555

5656

5757
data ListOptions = ListOptions
58-
{ loTool :: Maybe Tool
59-
, lCriteria :: Maybe ListCriteria
58+
{ loTool :: [Tool]
59+
, lCriteria :: [ListCriteria]
6060
, lFrom :: Maybe Day
6161
, lTo :: Maybe Day
6262
, lHideOld :: Bool
@@ -74,15 +74,15 @@ data ListOptions = ListOptions
7474
listOpts :: Parser ListOptions
7575
listOpts =
7676
ListOptions
77-
<$> optional
77+
<$> many
7878
(option
7979
(eitherReader toolParser)
80-
(short 't' <> long "tool" <> metavar "<ghc|cabal|hls|stack>" <> help
80+
(short 't' <> long "tool" <> metavar "<ghc|cabal|hls|stack|ghcup>" <> help
8181
"Tool to list versions for. Default is all"
8282
<> completer toolCompleter
8383
)
8484
)
85-
<*> optional
85+
<*> many
8686
(option
8787
(eitherReader criteriaParser)
8888
( short 'c'
@@ -238,7 +238,7 @@ list :: ( Monad m
238238
-> m ExitCode
239239
list ListOptions{..} no_color pgc runAppState =
240240
runAppState (do
241-
l <- listVersions loTool (maybeToList lCriteria) lHideOld lShowNightly (lFrom, lTo)
241+
l <- listVersions loTool lCriteria lHideOld lShowNightly (lFrom, lTo)
242242
printListResult no_color pgc lRawFormat l
243243
pure ExitSuccess
244244
)

‎lib-opt/GHCup/OptParse/Nuke.hs‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -78,7 +78,7 @@ nuke appState runLogger = do
7878
lift $ logInfo "Initiating Nuclear Sequence 🚀🚀🚀"
7979
lift $ logInfo "Nuking in 3...2...1"
8080

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

8383
forM_ lInstalled (liftE . rmTool)
8484

‎lib-tui/GHCup/Brick/Actions.hs‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -702,7 +702,7 @@ getAppData mgi = runExceptT $ do
702702
settings <- liftIO $ readIORef settings'
703703

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

708708
--

‎lib/GHCup.hs‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -557,7 +557,7 @@ rmUnsetTools :: ( MonadReader env m
557557
)
558558
=> Excepts '[NotInstalled, UninstallFailed] m ()
559559
rmUnsetTools = do
560-
vers <- lift $ listVersions Nothing [ListInstalled True, ListSet False] False True (Nothing, Nothing)
560+
vers <- lift $ listVersions [] [ListInstalled True, ListSet False] False True (Nothing, Nothing)
561561
forM_ vers $ \ListResult{..} -> case lTool of
562562
GHC -> liftE $ rmGHCVer (GHCTargetVersion lCross lVer)
563563
HLS -> liftE $ rmHLSVer lVer

‎lib/GHCup/List.hs‎

Lines changed: 12 additions & 18 deletions
Original file line numberDiff line numberDiff line change
@@ -103,7 +103,7 @@ listVersions :: ( MonadCatch m
103103
, HasPlatformReq env
104104
, HasGHCupInfo env
105105
)
106-
=> Maybe Tool
106+
=> [Tool]
107107
-> [ListCriteria]
108108
-> Bool
109109
-> Bool
@@ -119,17 +119,16 @@ listVersions lt' criteria hideOld showNightly days = do
119119
stacks <- getInstalledStacks
120120
hlsGHCVs <- fmap mkTVer <$> hlsGHCVersions
121121

122-
go lt' hlsGHCVs cSet cabals hlsSet' hlses sSet stacks
122+
go (if null lt' then [GHC, Cabal, HLS, Stack, GHCup] else lt') hlsGHCVs cSet cabals hlsSet' hlses sSet stacks
123123
where
124-
go lt hlsGHCVs cSet cabals hlsSet' hlses sSet stacks = do
125-
case lt of
126-
Just t -> do
127-
GHCupInfo { _ghcupDownloads = dls } <- getGHCupInfo
128-
-- get versions from GHCupDownloads
129-
let avTools = availableToolVersions dls t
130-
lr <- filter' <$> forM (Map.toList avTools) (toListResult t hlsGHCVs cSet cabals hlsSet' hlses sSet stacks)
131-
132-
case t of
124+
go [] _hlsGHCVs _cSet _cabals _hlsSet' _hlses _sSet _stacks = pure []
125+
go (lt:lts) hlsGHCVs cSet cabals hlsSet' hlses sSet stacks = do
126+
GHCupInfo { _ghcupDownloads = dls } <- getGHCupInfo
127+
-- get versions from GHCupDownloads
128+
let avTools = availableToolVersions dls lt
129+
lr <- filter' <$> forM (Map.toList avTools) (toListResult lt hlsGHCVs cSet cabals hlsSet' hlses sSet stacks)
130+
131+
r <- case lt of
133132
GHC -> do
134133
slr <- strayGHCs avTools
135134
pure (sort (slr ++ lr))
@@ -145,13 +144,8 @@ listVersions lt' criteria hideOld showNightly days = do
145144
GHCup -> do
146145
let cg = maybeToList $ currentGHCup avTools
147146
pure (sort (cg ++ lr))
148-
Nothing -> do
149-
ghcvers <- go (Just GHC) hlsGHCVs cSet cabals hlsSet' hlses sSet stacks
150-
cabalvers <- go (Just Cabal) hlsGHCVs cSet cabals hlsSet' hlses sSet stacks
151-
hlsvers <- go (Just HLS) hlsGHCVs cSet cabals hlsSet' hlses sSet stacks
152-
ghcupvers <- go (Just GHCup) hlsGHCVs cSet cabals hlsSet' hlses sSet stacks
153-
stackvers <- go (Just Stack) hlsGHCVs cSet cabals hlsSet' hlses sSet stacks
154-
pure (ghcvers <> cabalvers <> hlsvers <> stackvers <> ghcupvers)
147+
rn <- go lts hlsGHCVs cSet cabals hlsSet' hlses sSet stacks
148+
pure (r <> rn)
155149
strayGHCs :: ( MonadCatch m
156150
, MonadReader env m
157151
, HasDirs env

‎lib/GHCup/Utils/Parsers.hs‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -174,6 +174,7 @@ toolParser s' | t == T.pack "ghc" = Right GHC
174174
| t == T.pack "cabal" = Right Cabal
175175
| t == T.pack "hls" = Right HLS
176176
| t == T.pack "stack" = Right Stack
177+
| t == T.pack "ghcup" = Right GHCup
177178
| otherwise = Left ("Unknown tool: " <> s')
178179
where t = T.toLower (T.pack s')
179180

‎test/optparse-test/ListTest.hs‎

Lines changed: 14 additions & 14 deletions
Original file line numberDiff line numberDiff line change
@@ -11,24 +11,24 @@ listTests :: TestTree
1111
listTests = buildTestTree listParseWith ("list", listCheckList)
1212

1313
defaultOptions :: ListOptions
14-
defaultOptions = ListOptions Nothing Nothing Nothing Nothing False False False
14+
defaultOptions = ListOptions [] [] Nothing Nothing False False False
1515

1616
listCheckList :: [(String, ListOptions)]
1717
listCheckList =
1818
[ ("list", defaultOptions)
19-
, ("list -t ghc", defaultOptions{loTool = Just GHC})
20-
, ("list -t cabal", defaultOptions{loTool = Just Cabal})
21-
, ("list -t hls", defaultOptions{loTool = Just HLS})
22-
, ("list -t stack", defaultOptions{loTool = Just Stack})
23-
, ("list -c installed", defaultOptions{lCriteria = Just $ ListInstalled True})
24-
, ("list -c +installed", defaultOptions{lCriteria = Just $ ListInstalled True})
25-
, ("list -c -installed", defaultOptions{lCriteria = Just $ ListInstalled False})
26-
, ("list -c set", defaultOptions{lCriteria = Just $ ListSet True})
27-
, ("list -c +set", defaultOptions{lCriteria = Just $ ListSet True})
28-
, ("list -c -set", defaultOptions{lCriteria = Just $ ListSet False})
29-
, ("list -c available", defaultOptions{lCriteria = Just $ ListAvailable True})
30-
, ("list -c +available", defaultOptions{lCriteria = Just $ ListAvailable True})
31-
, ("list -c -available", defaultOptions{lCriteria = Just $ ListAvailable False})
19+
, ("list -t ghc", defaultOptions{loTool = [GHC]})
20+
, ("list -t cabal", defaultOptions{loTool = [Cabal]})
21+
, ("list -t hls", defaultOptions{loTool = [HLS]})
22+
, ("list -t stack", defaultOptions{loTool = [Stack]})
23+
, ("list -c installed", defaultOptions{lCriteria = [ListInstalled True]})
24+
, ("list -c +installed", defaultOptions{lCriteria = [ListInstalled True]})
25+
, ("list -c -installed", defaultOptions{lCriteria = [ListInstalled False]})
26+
, ("list -c set", defaultOptions{lCriteria = [ListSet True]})
27+
, ("list -c +set", defaultOptions{lCriteria = [ListSet True]})
28+
, ("list -c -set", defaultOptions{lCriteria = [ListSet False]})
29+
, ("list -c available", defaultOptions{lCriteria = [ListAvailable True]})
30+
, ("list -c +available", defaultOptions{lCriteria = [ListAvailable True]})
31+
, ("list -c -available", defaultOptions{lCriteria = [ListAvailable False]})
3232
, ("list -s 2023-07-22", defaultOptions{lFrom = Just $ read "2023-07-22"})
3333
, ("list -u 2023-07-22", defaultOptions{lTo = Just $ read "2023-07-22"})
3434
, ("list --since 2023-07-22 --until 2023-07-22", defaultOptions{lFrom = Just $ read "2023-07-22", lTo = Just $ read "2023-07-22"})

0 commit comments

Comments
 (0)