filter tool and version instead of URL
This commit is contained in:
parent
56569a0698
commit
62d5d53232
@ -14,6 +14,7 @@ import GHCup.Types
|
|||||||
import GHCup.Types.JSON ( )
|
import GHCup.Types.JSON ( )
|
||||||
import GHCup.Utils.Logger
|
import GHCup.Utils.Logger
|
||||||
|
|
||||||
|
import Control.Monad
|
||||||
#if !MIN_VERSION_base(4,13,0)
|
#if !MIN_VERSION_base(4,13,0)
|
||||||
import Data.Semigroup ( (<>) )
|
import Data.Semigroup ( (<>) )
|
||||||
#endif
|
#endif
|
||||||
@ -33,7 +34,7 @@ data Options = Options
|
|||||||
}
|
}
|
||||||
|
|
||||||
data Command = ValidateYAML ValidateYAMLOpts
|
data Command = ValidateYAML ValidateYAMLOpts
|
||||||
| ValidateTarballs ValidateYAMLOpts (Maybe Regex)
|
| ValidateTarballs ValidateYAMLOpts TarballFilter
|
||||||
|
|
||||||
|
|
||||||
data Input
|
data Input
|
||||||
@ -64,10 +65,18 @@ data ValidateYAMLOpts = ValidateYAMLOpts
|
|||||||
validateYAMLOpts :: Parser ValidateYAMLOpts
|
validateYAMLOpts :: Parser ValidateYAMLOpts
|
||||||
validateYAMLOpts = ValidateYAMLOpts <$> optional inputP
|
validateYAMLOpts = ValidateYAMLOpts <$> optional inputP
|
||||||
|
|
||||||
urlRegexP :: Parser (Maybe Regex)
|
tarballFilterP :: Parser TarballFilter
|
||||||
urlRegexP = optional . option (str @String >>= makeRegexM) $
|
tarballFilterP = option readm $
|
||||||
long "url-regex" <> short 'u' <> metavar "URL_REGEX"
|
long "tarball-filter" <> short 'u' <> metavar "<tool>-<version>" <> value def
|
||||||
<> help "Only validate if URL matches the regex"
|
<> help "Only check certain tarballs (format: <tool>-<version>, where <tool> is GHC by default)"
|
||||||
|
where
|
||||||
|
def = join TarballFilter $ 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
|
||||||
|
|
||||||
opts :: Parser Options
|
opts :: Parser Options
|
||||||
opts = Options <$> com
|
opts = Options <$> com
|
||||||
@ -85,7 +94,7 @@ com = subparser
|
|||||||
<> (command
|
<> (command
|
||||||
"check-tarballs"
|
"check-tarballs"
|
||||||
(info
|
(info
|
||||||
((ValidateTarballs <$> validateYAMLOpts <*> urlRegexP) <**> helper)
|
((ValidateTarballs <$> validateYAMLOpts <*> tarballFilterP) <**> helper)
|
||||||
(progDesc "Validate all tarballs (download and checksum)")
|
(progDesc "Validate all tarballs (download and checksum)")
|
||||||
)
|
)
|
||||||
)
|
)
|
||||||
@ -104,13 +113,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 urlRegex -> case vopts of
|
ValidateTarballs vopts tarballFilter -> case vopts of
|
||||||
ValidateYAMLOpts { vInput = Nothing } ->
|
ValidateYAMLOpts { vInput = Nothing } ->
|
||||||
B.getContents >>= valAndExit (validateTarballs urlRegex)
|
B.getContents >>= valAndExit (validateTarballs tarballFilter)
|
||||||
ValidateYAMLOpts { vInput = Just StdInput } ->
|
ValidateYAMLOpts { vInput = Just StdInput } ->
|
||||||
B.getContents >>= valAndExit (validateTarballs urlRegex)
|
B.getContents >>= valAndExit (validateTarballs tarballFilter)
|
||||||
ValidateYAMLOpts { vInput = Just (FileInput file) } ->
|
ValidateYAMLOpts { vInput = Just (FileInput file) } ->
|
||||||
B.readFile file >>= valAndExit (validateTarballs urlRegex)
|
B.readFile file >>= valAndExit (validateTarballs tarballFilter)
|
||||||
pure ()
|
pure ()
|
||||||
|
|
||||||
where
|
where
|
||||||
|
@ -33,7 +33,6 @@ import System.Exit
|
|||||||
import System.IO
|
import System.IO
|
||||||
import Text.ParserCombinators.ReadP
|
import Text.ParserCombinators.ReadP
|
||||||
import Text.Regex.Posix
|
import Text.Regex.Posix
|
||||||
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
|
||||||
@ -161,6 +160,11 @@ validate dls = do
|
|||||||
isBase (Base _) = True
|
isBase (Base _) = True
|
||||||
isBase _ = False
|
isBase _ = False
|
||||||
|
|
||||||
|
data TarballFilter = TarballFilter
|
||||||
|
{ tfTool :: Regex
|
||||||
|
, tfVersion :: Regex
|
||||||
|
}
|
||||||
|
|
||||||
validateTarballs :: ( Monad m
|
validateTarballs :: ( Monad m
|
||||||
, MonadLogger m
|
, MonadLogger m
|
||||||
, MonadThrow m
|
, MonadThrow m
|
||||||
@ -168,19 +172,18 @@ validateTarballs :: ( Monad m
|
|||||||
, MonadUnliftIO m
|
, MonadUnliftIO m
|
||||||
, MonadMask m
|
, MonadMask m
|
||||||
)
|
)
|
||||||
=> Maybe Regex
|
=> TarballFilter
|
||||||
-> GHCupDownloads
|
-> GHCupDownloads
|
||||||
-> m ExitCode
|
-> m ExitCode
|
||||||
validateTarballs urlRegex dls = do
|
validateTarballs (TarballFilter toolRegex versionRegex) 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 $ dls ^.. each
|
||||||
dls ^.. each % each % (viSourceDL % _Just `summing` viArch % each % each % each)
|
%& indices (matchTest toolRegex . show) %> each
|
||||||
matchingUrl dli = case urlRegex of
|
%& indices (matchTest versionRegex . T.unpack . prettyVer)
|
||||||
Nothing -> True
|
% (viSourceDL % _Just `summing` viArch % each % each % each)
|
||||||
Just r -> matchTest r $ serializeURIRef' (_dlUri dli)
|
|
||||||
forM_ dlis $ downloadAll
|
forM_ dlis $ downloadAll
|
||||||
|
|
||||||
-- exit
|
-- exit
|
||||||
|
Loading…
Reference in New Issue
Block a user