use regex instead of substring
This commit is contained in:
parent
8944ed6e36
commit
56569a0698
@ -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
|
||||||
|
@ -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
|
||||||
|
@ -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
|
||||||
|
Loading…
Reference in New Issue
Block a user