Skip to content
Snippets Groups Projects

allow to filter tarball validation by a URL substring

Merged amesgen requested to merge amesgen/ghcup-hs:check-tarball-filter into master
2 unresolved threads
Files
4
+ 26
10
@@ -14,6 +14,7 @@ import GHCup.Types
@@ -14,6 +14,7 @@ import GHCup.Types
import GHCup.Types.JSON ( )
import GHCup.Types.JSON ( )
import GHCup.Utils.Logger
import GHCup.Utils.Logger
 
import Data.Char ( toLower )
#if !MIN_VERSION_base(4,13,0)
#if !MIN_VERSION_base(4,13,0)
import Data.Semigroup ( (<>) )
import Data.Semigroup ( (<>) )
#endif
#endif
@@ -21,6 +22,7 @@ import Options.Applicative hiding ( style )
@@ -21,6 +22,7 @@ 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
@@ -32,7 +34,7 @@ data Options = Options
@@ -32,7 +34,7 @@ data Options = Options
}
}
data Command = ValidateYAML ValidateYAMLOpts
data Command = ValidateYAML ValidateYAMLOpts
| ValidateTarballs ValidateYAMLOpts
| ValidateTarballs ValidateYAMLOpts TarballFilter
data Input
data Input
@@ -63,6 +65,22 @@ data ValidateYAMLOpts = ValidateYAMLOpts
@@ -63,6 +65,22 @@ data ValidateYAMLOpts = ValidateYAMLOpts
validateYAMLOpts :: Parser ValidateYAMLOpts
validateYAMLOpts :: Parser ValidateYAMLOpts
validateYAMLOpts = ValidateYAMLOpts <$> optional inputP
validateYAMLOpts = ValidateYAMLOpts <$> optional inputP
 
tarballFilterP :: Parser TarballFilter
 
tarballFilterP = option readm $
 
long "tarball-filter" <> short 'u' <> metavar "<tool>-<version>" <> value def
 
<> help "Only check certain tarballs (format: <tool>-<version>)"
 
where
 
def = TarballFilter Nothing (makeRegex ("" :: String))
 
readm = do
 
s <- str
 
case span (/= '-') s of
 
(_, []) -> fail "invalid format, missing '-' after the tool name"
 
(t, v) | [tool] <- [ tool | tool <- [minBound..maxBound], low (show tool) == low t ] ->
 
TarballFilter <$> pure (Just tool) <*> makeRegexOptsM compIgnoreCase execBlank (drop 1 v)
 
_ -> fail "invalid tool"
 
low = fmap toLower
 
 
opts :: Parser Options
opts :: Parser Options
opts = Options <$> com
opts = Options <$> com
@@ -78,11 +96,9 @@ com = subparser
@@ -78,11 +96,9 @@ com = subparser
)
)
<> (command
<> (command
"check-tarballs"
"check-tarballs"
( ValidateTarballs
(info
<$> (info
((ValidateTarballs <$> validateYAMLOpts <*> tarballFilterP) <**> helper)
(validateYAMLOpts <**> helper)
(progDesc "Validate all tarballs (download and checksum)")
(progDesc "Validate all tarballs (download and checksum)")
)
)
)
)
)
)
)
@@ -100,13 +116,13 @@ main = do
@@ -100,13 +116,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 -> case vopts of
ValidateTarballs vopts tarballFilter -> case vopts of
ValidateYAMLOpts { vInput = Nothing } ->
ValidateYAMLOpts { vInput = Nothing } ->
B.getContents >>= valAndExit validateTarballs
B.getContents >>= valAndExit (validateTarballs tarballFilter)
ValidateYAMLOpts { vInput = Just StdInput } ->
ValidateYAMLOpts { vInput = Just StdInput } ->
B.getContents >>= valAndExit validateTarballs
B.getContents >>= valAndExit (validateTarballs tarballFilter)
ValidateYAMLOpts { vInput = Just (FileInput file) } ->
ValidateYAMLOpts { vInput = Just (FileInput file) } ->
B.readFile file >>= valAndExit validateTarballs
B.readFile file >>= valAndExit (validateTarballs tarballFilter)
pure ()
pure ()
where
where
Loading