From dc6d43ddba91fc29702b91880fd611bbd5fcf2a6 Mon Sep 17 00:00:00 2001
From: Julian Ospald <hasufell@posteo.de>
Date: Fri, 17 Nov 2023 22:24:19 +0800
Subject: [PATCH] Update ghcup-gen

---
 cabal.project             |  2 +-
 ghcup-gen/Main.hs         |  8 +++-----
 ghcup-gen/Validate.hs     | 30 +++++++++++-------------------
 ghcup-gen/ghcup-gen.cabal |  2 +-
 4 files changed, 16 insertions(+), 26 deletions(-)

diff --git a/cabal.project b/cabal.project
index 6a87d11..64d5ad1 100644
--- a/cabal.project
+++ b/cabal.project
@@ -7,7 +7,7 @@ package ghcup
 source-repository-package
   type: git
   location: https://github.com/haskell/ghcup-hs.git
-  tag: e27fed09f3eb4b0b72ce7825c65f16a4202a2399
+  tag: b1106985ec1173a0122f2781719e9bb1a85de257
 
 constraints: http-io-streams -brotli,
              any.aeson >= 2.0.1.0
diff --git a/ghcup-gen/Main.hs b/ghcup-gen/Main.hs
index da92d7d..fb87ba5 100644
--- a/ghcup-gen/Main.hs
+++ b/ghcup-gen/Main.hs
@@ -135,15 +135,13 @@ tarballFilterP = option readm $
   long "tarball-filter" <> short 'u' <> metavar "<tool>-<version>" <> value def
     <> help "Only check certain tarballs (format: <tool>-<version>)"
   where
-    def = TarballFilter (Right Nothing) (makeRegex ("" :: String))
+    def = TarballFilter Nothing (makeRegex ("" :: String))
     readm = do
       s <- str
       case span (/= '-') s of
         (_, []) -> fail "invalid format, missing '-' after the tool name"
         (t, v) | [tool] <- [ tool | tool <- [minBound..maxBound], low (show tool) == low t ] ->
-          pure (TarballFilter $ Right $ Just tool) <*> makeRegexOptsM compIgnoreCase execBlank (drop 1 v)
-        (t, v) | [tool] <- [ tool | tool <- [minBound..maxBound], low (show tool) == low t ] ->
-          pure (TarballFilter $ Left tool) <*> makeRegexOptsM compIgnoreCase execBlank (drop 1 v)
+          pure (TarballFilter $ Just tool) <*> makeRegexOptsM compIgnoreCase execBlank (drop 1 v)
         _ -> fail "invalid tool"
     low = fmap toLower
 
@@ -206,7 +204,7 @@ main = do
               flip runReaderT leanAppstate $ logError $ T.pack $ prettyShow e
               liftIO $ exitWith (ExitFailure 2)
 
-  let appstate = AppState (Settings True 0 Lax False Never Curl True GHCupURL False GPGNone True Nothing (DM mempty)) dirs defaultKeyBindings (GHCupInfo mempty mempty mempty) pfreq loggerConfig
+  let appstate = AppState (Settings True 0 Lax False Never Curl True GHCupURL False GPGNone True Nothing (DM mempty)) dirs defaultKeyBindings (GHCupInfo mempty mempty Nothing) pfreq loggerConfig
 
   let withValidateYamlOpts vopts f = case vopts of
         ValidateYAMLOpts { vInput = Nothing } ->
diff --git a/ghcup-gen/Validate.hs b/ghcup-gen/Validate.hs
index 949e888..97a474a 100644
--- a/ghcup-gen/Validate.hs
+++ b/ghcup-gen/Validate.hs
@@ -207,7 +207,7 @@ validate distroChannel = do
   isBase _        = False
 
 data TarballFilter = TarballFilter
-  { tfTool    :: Either GlobalTool (Maybe Tool)
+  { tfTool    :: Maybe Tool
   , tfVersion :: Regex
   }
 
@@ -226,20 +226,16 @@ validateTarballs :: ( Monad m
                     )
                  => TarballFilter
                  -> m ExitCode
-validateTarballs (TarballFilter etool versionRegex) = do
-  GHCupInfo { _ghcupDownloads = dls, _globalTools = gt } <- getGHCupInfo
+validateTarballs (TarballFilter mtool versionRegex) = do
+  GHCupInfo { _ghcupDownloads = dls } <- getGHCupInfo
   ref <- liftIO $ newIORef 0
 
    -- download/verify all tarballs
-  let dlis = either (const []) (\tool -> nubOrd $ dls ^.. each %& indices (maybe (const True) (==) tool)
-                                 %> each %& indices (matchTest versionRegex . T.unpack . prettyVer . _tvVersion)
-                                                  % (viTestDL % _Just `summing` viSourceDL % _Just `summing` viArch % each % each % each)
-                               )
-                               etool
-  let gdlis = nubOrd $ gt ^.. each
-  let allDls = either (const gdlis) (const dlis) etool
-  when (null allDls) $ logError "no tarballs selected by filter" *> runReaderT addError ref
-  forM_ allDls (downloadAll ref)
+  let dlis = nubOrd $ dls ^.. each %& indices (maybe (const True) (==) mtool)
+                    %> each %& indices (matchTest versionRegex . T.unpack . prettyVer . _tvVersion)
+                    % (viTestDL % _Just `summing` viSourceDL % _Just `summing` viArch % each % each % each)
+  when (null dlis) $ logError "no tarballs selected by filter" *> runReaderT addError ref
+  forM_ dlis (downloadAll ref)
 
   -- exit
   e <- liftIO $ readIORef ref
@@ -273,20 +269,16 @@ validateTarballs (TarballFilter etool versionRegex) = do
                , ContentLengthError
                ]
       $ do
-        case etool of
-          Right (Just GHCup) -> do
+        case mtool of
+          (Just GHCup) -> do
             tmpUnpack <- lift mkGhcupTmpDir
             _ <- liftE $ download (_dlUri dli) Nothing (Just (_dlHash dli)) Nothing (fromGHCupPath tmpUnpack) Nothing False
             pure Nothing
-          Right _ -> do
+          _ -> do
             p <- liftE $ downloadCached dli Nothing
             fmap Just $ liftE
                   . getArchiveFiles
                   $ p
-          Left ShimGen -> do
-            tmpUnpack <- lift mkGhcupTmpDir
-            _ <- liftE $ download (_dlUri dli) Nothing (Just (_dlHash dli)) Nothing (fromGHCupPath tmpUnpack) Nothing False
-            pure Nothing
     case r of
       VRight (Just entries) -> do
         case _dlSubdir dli of
diff --git a/ghcup-gen/ghcup-gen.cabal b/ghcup-gen/ghcup-gen.cabal
index cc5d9e5..2524595 100644
--- a/ghcup-gen/ghcup-gen.cabal
+++ b/ghcup-gen/ghcup-gen.cabal
@@ -65,5 +65,5 @@ executable ghcup-gen
     , safe-exceptions       ^>=0.1
     , text                  ^>=2.0
     , transformers          ^>=0.5
-    , versions              >=4.0.1    && <5.1
+    , versions              >=6.0.0
     , yaml-streamly         ^>=0.12.0