From 56569a06983a061ba5e393f5950fbd9b35e6828c Mon Sep 17 00:00:00 2001
From: amesgen <amesgen@amesgen.de>
Date: Sat, 2 Jan 2021 05:05:05 +0100
Subject: [PATCH] use regex instead of substring

---
 app/ghcup-gen/Main.hs     | 22 +++++++++++-----------
 app/ghcup-gen/Validate.hs | 10 +++++-----
 ghcup.cabal               |  1 +
 3 files changed, 17 insertions(+), 16 deletions(-)

diff --git a/app/ghcup-gen/Main.hs b/app/ghcup-gen/Main.hs
index 38d89c9..0ad34ca 100644
--- a/app/ghcup-gen/Main.hs
+++ b/app/ghcup-gen/Main.hs
@@ -21,10 +21,10 @@ import           Options.Applicative     hiding ( style )
 import           System.Console.Pretty
 import           System.Exit
 import           System.IO                      ( stdout )
+import           Text.Regex.Posix
 import           Validate
 
 import qualified Data.ByteString               as B
-import qualified Data.Text                     as T
 import qualified Data.Yaml                     as Y
 
 
@@ -33,7 +33,7 @@ data Options = Options
   }
 
 data Command = ValidateYAML ValidateYAMLOpts
-             | ValidateTarballs ValidateYAMLOpts (Maybe T.Text)
+             | ValidateTarballs ValidateYAMLOpts (Maybe Regex)
 
 
 data Input
@@ -64,10 +64,10 @@ data ValidateYAMLOpts = ValidateYAMLOpts
 validateYAMLOpts :: Parser ValidateYAMLOpts
 validateYAMLOpts = ValidateYAMLOpts <$> optional inputP
 
-urlSubstrP :: Parser (Maybe T.Text)
-urlSubstrP = optional . strOption $
-  long "url-substr" <> short 'u' <> metavar "URL_SUBSTRING"
-    <> help "Only validate if URL contains this substring"
+urlRegexP :: Parser (Maybe Regex)
+urlRegexP = optional . option (str @String >>= makeRegexM) $
+  long "url-regex" <> short 'u' <> metavar "URL_REGEX"
+    <> help "Only validate if URL matches the regex"
 
 opts :: Parser Options
 opts = Options <$> com
@@ -85,7 +85,7 @@ com = subparser
   <> (command
        "check-tarballs"
        (info
-         ((ValidateTarballs <$> validateYAMLOpts <*> urlSubstrP) <**> helper)
+         ((ValidateTarballs <$> validateYAMLOpts <*> urlRegexP) <**> helper)
          (progDesc "Validate all tarballs (download and checksum)")
        )
      )
@@ -104,13 +104,13 @@ main = do
               B.getContents >>= valAndExit validate
             ValidateYAMLOpts { vInput = Just (FileInput file) } ->
               B.readFile file >>= valAndExit validate
-          ValidateTarballs vopts urlSubstr -> case vopts of
+          ValidateTarballs vopts urlRegex -> case vopts of
             ValidateYAMLOpts { vInput = Nothing } ->
-              B.getContents >>= valAndExit (validateTarballs urlSubstr)
+              B.getContents >>= valAndExit (validateTarballs urlRegex)
             ValidateYAMLOpts { vInput = Just StdInput } ->
-              B.getContents >>= valAndExit (validateTarballs urlSubstr)
+              B.getContents >>= valAndExit (validateTarballs urlRegex)
             ValidateYAMLOpts { vInput = Just (FileInput file) } ->
-              B.readFile file >>= valAndExit (validateTarballs urlSubstr)
+              B.readFile file >>= valAndExit (validateTarballs urlRegex)
   pure ()
 
  where
diff --git a/app/ghcup-gen/Validate.hs b/app/ghcup-gen/Validate.hs
index 8f28153..6ea8693 100644
--- a/app/ghcup-gen/Validate.hs
+++ b/app/ghcup-gen/Validate.hs
@@ -32,12 +32,12 @@ import           Optics
 import           System.Exit
 import           System.IO
 import           Text.ParserCombinators.ReadP
+import           Text.Regex.Posix
 import           URI.ByteString
 
 import qualified Data.ByteString               as B
 import qualified Data.Map.Strict               as M
 import qualified Data.Text                     as T
-import qualified Data.Text.Encoding            as E
 import qualified Data.Version                  as V
 
 
@@ -168,19 +168,19 @@ validateTarballs :: ( Monad m
                     , MonadUnliftIO m
                     , MonadMask m
                     )
-                 => Maybe T.Text
+                 => Maybe Regex
                  -> GHCupDownloads
                  -> m ExitCode
-validateTarballs urlSubstr dls = do
+validateTarballs urlRegex dls = do
   ref <- liftIO $ newIORef 0
 
   flip runReaderT ref $ do
      -- download/verify all tarballs
     let dlis = nubOrd . filter matchingUrl $
           dls ^.. each % each % (viSourceDL % _Just `summing` viArch % each % each % each)
-        matchingUrl dli = case urlSubstr of
+        matchingUrl dli = case urlRegex of
           Nothing -> True
-          Just sub -> E.encodeUtf8 sub `B.isInfixOf` serializeURIRef' (_dlUri dli)
+          Just r -> matchTest r $ serializeURIRef' (_dlUri dli)
     forM_ dlis $ downloadAll
 
     -- exit
diff --git a/ghcup.cabal b/ghcup.cabal
index 78772c3..ef77118 100644
--- a/ghcup.cabal
+++ b/ghcup.cabal
@@ -431,6 +431,7 @@ executable ghcup-gen
     , optics
     , optparse-applicative
     , pretty-terminal
+    , regex-posix
     , resourcet
     , safe-exceptions
     , string-interpolate