From 53db68e39f0d484e1a4fd8b6e2b2397b0fba784a Mon Sep 17 00:00:00 2001
From: amesgen <amesgen@amesgen.de>
Date: Sat, 2 Jan 2021 07:58:08 +0100
Subject: [PATCH] minor tarball filter format change

---
 app/ghcup-gen/Main.hs     | 17 ++++++++++-------
 app/ghcup-gen/Validate.hs |  6 +++---
 lib/GHCup/Types.hs        |  2 +-
 3 files changed, 14 insertions(+), 11 deletions(-)

diff --git a/app/ghcup-gen/Main.hs b/app/ghcup-gen/Main.hs
index 6650f76..74fbc03 100644
--- a/app/ghcup-gen/Main.hs
+++ b/app/ghcup-gen/Main.hs
@@ -14,7 +14,7 @@ import           GHCup.Types
 import           GHCup.Types.JSON               ( )
 import           GHCup.Utils.Logger
 
-import           Control.Monad
+import           Data.Char                      ( toLower )
 #if !MIN_VERSION_base(4,13,0)
 import           Data.Semigroup                 ( (<>) )
 #endif
@@ -68,15 +68,18 @@ validateYAMLOpts = ValidateYAMLOpts <$> optional inputP
 tarballFilterP :: Parser TarballFilter
 tarballFilterP = option readm $
   long "tarball-filter" <> short 'u' <> metavar "<tool>-<version>" <> value def
-    <> help "Only check certain tarballs (format: <tool>-<version>, where <tool> is GHC by default)"
+    <> help "Only check certain tarballs (format: <tool>-<version>)"
   where
-    def = join TarballFilter $ makeRegex ("" :: String)
+    def = TarballFilter Nothing (makeRegex ("" :: String))
     readm = do
       s <- str
-      (t, v) <- case span (/= '-') s of
-        (v, []) -> pure ("", v)
-        (t, v) -> pure (t, drop 1 v)
-      TarballFilter <$> makeRegexOptsM compIgnoreCase execBlank t <*> makeRegexM v
+      case span (/= '-') s of
+        (_, []) -> fail "invalid format, missing '-' after the tool name"
+        (t, v) | [tool] <- [ tool | tool <- [minBound..maxBound], low (show tool) == low t ] ->
+          TarballFilter <$> pure (Just tool) <*> makeRegexOptsM compIgnoreCase execBlank (drop 1 v)
+        _ -> fail "invalid tool"
+    low = fmap toLower
+
 
 opts :: Parser Options
 opts = Options <$> com
diff --git a/app/ghcup-gen/Validate.hs b/app/ghcup-gen/Validate.hs
index a6c826c..bdea1fe 100644
--- a/app/ghcup-gen/Validate.hs
+++ b/app/ghcup-gen/Validate.hs
@@ -161,7 +161,7 @@ validate dls = do
   isBase _        = False
 
 data TarballFilter = TarballFilter
-  { tfTool    :: Regex
+  { tfTool    :: Maybe Tool
   , tfVersion :: Regex
   }
 
@@ -175,13 +175,13 @@ validateTarballs :: ( Monad m
                  => TarballFilter
                  -> GHCupDownloads
                  -> m ExitCode
-validateTarballs (TarballFilter toolRegex versionRegex) dls = do
+validateTarballs (TarballFilter tool versionRegex) dls = do
   ref <- liftIO $ newIORef 0
 
   flip runReaderT ref $ do
      -- download/verify all tarballs
     let dlis = nubOrd $ dls ^.. each
-          %& indices (matchTest toolRegex . show) %> each
+          %& indices (maybe (const True) (==) tool) %> each
           %& indices (matchTest versionRegex . T.unpack . prettyVer)
           % (viSourceDL % _Just `summing` viArch % each % each % each)
     forM_ dlis $ downloadAll
diff --git a/lib/GHCup/Types.hs b/lib/GHCup/Types.hs
index a9864c9..761ca10 100644
--- a/lib/GHCup/Types.hs
+++ b/lib/GHCup/Types.hs
@@ -79,7 +79,7 @@ data Tool = GHC
           | Cabal
           | GHCup
           | HLS
-  deriving (Eq, GHC.Generic, Ord, Show)
+  deriving (Eq, GHC.Generic, Ord, Show, Enum, Bounded)
 
 
 -- | All necessary information of a tool version, including