use regex instead of substring

This commit is contained in:
amesgen 2021-01-02 05:05:05 +01:00
parent 8944ed6e36
commit 56569a0698
No known key found for this signature in database
GPG Key ID: 1A89EC203635A13D
3 changed files with 17 additions and 16 deletions

View File

@ -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

View File

@ -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

View File

@ -431,6 +431,7 @@ executable ghcup-gen
, optics
, optparse-applicative
, pretty-terminal
, regex-posix
, resourcet
, safe-exceptions
, string-interpolate