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.Console.Pretty
import System.Exit import System.Exit
import System.IO ( stdout ) import System.IO ( stdout )
import Text.Regex.Posix
import Validate import Validate
import qualified Data.ByteString as B import qualified Data.ByteString as B
import qualified Data.Text as T
import qualified Data.Yaml as Y import qualified Data.Yaml as Y
@ -33,7 +33,7 @@ data Options = Options
} }
data Command = ValidateYAML ValidateYAMLOpts data Command = ValidateYAML ValidateYAMLOpts
| ValidateTarballs ValidateYAMLOpts (Maybe T.Text) | ValidateTarballs ValidateYAMLOpts (Maybe Regex)
data Input data Input
@ -64,10 +64,10 @@ data ValidateYAMLOpts = ValidateYAMLOpts
validateYAMLOpts :: Parser ValidateYAMLOpts validateYAMLOpts :: Parser ValidateYAMLOpts
validateYAMLOpts = ValidateYAMLOpts <$> optional inputP validateYAMLOpts = ValidateYAMLOpts <$> optional inputP
urlSubstrP :: Parser (Maybe T.Text) urlRegexP :: Parser (Maybe Regex)
urlSubstrP = optional . strOption $ urlRegexP = optional . option (str @String >>= makeRegexM) $
long "url-substr" <> short 'u' <> metavar "URL_SUBSTRING" long "url-regex" <> short 'u' <> metavar "URL_REGEX"
<> help "Only validate if URL contains this substring" <> help "Only validate if URL matches the regex"
opts :: Parser Options opts :: Parser Options
opts = Options <$> com opts = Options <$> com
@ -85,7 +85,7 @@ com = subparser
<> (command <> (command
"check-tarballs" "check-tarballs"
(info (info
((ValidateTarballs <$> validateYAMLOpts <*> urlSubstrP) <**> helper) ((ValidateTarballs <$> validateYAMLOpts <*> urlRegexP) <**> helper)
(progDesc "Validate all tarballs (download and checksum)") (progDesc "Validate all tarballs (download and checksum)")
) )
) )
@ -104,13 +104,13 @@ main = do
B.getContents >>= valAndExit validate B.getContents >>= valAndExit validate
ValidateYAMLOpts { vInput = Just (FileInput file) } -> ValidateYAMLOpts { vInput = Just (FileInput file) } ->
B.readFile file >>= valAndExit validate B.readFile file >>= valAndExit validate
ValidateTarballs vopts urlSubstr -> case vopts of ValidateTarballs vopts urlRegex -> case vopts of
ValidateYAMLOpts { vInput = Nothing } -> ValidateYAMLOpts { vInput = Nothing } ->
B.getContents >>= valAndExit (validateTarballs urlSubstr) B.getContents >>= valAndExit (validateTarballs urlRegex)
ValidateYAMLOpts { vInput = Just StdInput } -> ValidateYAMLOpts { vInput = Just StdInput } ->
B.getContents >>= valAndExit (validateTarballs urlSubstr) B.getContents >>= valAndExit (validateTarballs urlRegex)
ValidateYAMLOpts { vInput = Just (FileInput file) } -> ValidateYAMLOpts { vInput = Just (FileInput file) } ->
B.readFile file >>= valAndExit (validateTarballs urlSubstr) B.readFile file >>= valAndExit (validateTarballs urlRegex)
pure () pure ()
where where

View File

@ -32,12 +32,12 @@ import Optics
import System.Exit import System.Exit
import System.IO import System.IO
import Text.ParserCombinators.ReadP import Text.ParserCombinators.ReadP
import Text.Regex.Posix
import URI.ByteString import URI.ByteString
import qualified Data.ByteString as B import qualified Data.ByteString as B
import qualified Data.Map.Strict as M import qualified Data.Map.Strict as M
import qualified Data.Text as T import qualified Data.Text as T
import qualified Data.Text.Encoding as E
import qualified Data.Version as V import qualified Data.Version as V
@ -168,19 +168,19 @@ validateTarballs :: ( Monad m
, MonadUnliftIO m , MonadUnliftIO m
, MonadMask m , MonadMask m
) )
=> Maybe T.Text => Maybe Regex
-> GHCupDownloads -> GHCupDownloads
-> m ExitCode -> m ExitCode
validateTarballs urlSubstr dls = do validateTarballs urlRegex dls = do
ref <- liftIO $ newIORef 0 ref <- liftIO $ newIORef 0
flip runReaderT ref $ do flip runReaderT ref $ do
-- download/verify all tarballs -- download/verify all tarballs
let dlis = nubOrd . filter matchingUrl $ let dlis = nubOrd . filter matchingUrl $
dls ^.. each % each % (viSourceDL % _Just `summing` viArch % each % each % each) dls ^.. each % each % (viSourceDL % _Just `summing` viArch % each % each % each)
matchingUrl dli = case urlSubstr of matchingUrl dli = case urlRegex of
Nothing -> True Nothing -> True
Just sub -> E.encodeUtf8 sub `B.isInfixOf` serializeURIRef' (_dlUri dli) Just r -> matchTest r $ serializeURIRef' (_dlUri dli)
forM_ dlis $ downloadAll forM_ dlis $ downloadAll
-- exit -- exit

View File

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