Update ghcup-gen
This commit is contained in:
parent
174ff702a5
commit
dc6d43ddba
@ -7,7 +7,7 @@ package ghcup
|
|||||||
source-repository-package
|
source-repository-package
|
||||||
type: git
|
type: git
|
||||||
location: https://github.com/haskell/ghcup-hs.git
|
location: https://github.com/haskell/ghcup-hs.git
|
||||||
tag: e27fed09f3eb4b0b72ce7825c65f16a4202a2399
|
tag: b1106985ec1173a0122f2781719e9bb1a85de257
|
||||||
|
|
||||||
constraints: http-io-streams -brotli,
|
constraints: http-io-streams -brotli,
|
||||||
any.aeson >= 2.0.1.0
|
any.aeson >= 2.0.1.0
|
||||||
|
@ -135,15 +135,13 @@ tarballFilterP = option readm $
|
|||||||
long "tarball-filter" <> short 'u' <> metavar "<tool>-<version>" <> value def
|
long "tarball-filter" <> short 'u' <> metavar "<tool>-<version>" <> value def
|
||||||
<> help "Only check certain tarballs (format: <tool>-<version>)"
|
<> help "Only check certain tarballs (format: <tool>-<version>)"
|
||||||
where
|
where
|
||||||
def = TarballFilter (Right Nothing) (makeRegex ("" :: String))
|
def = TarballFilter Nothing (makeRegex ("" :: String))
|
||||||
readm = do
|
readm = do
|
||||||
s <- str
|
s <- str
|
||||||
case span (/= '-') s of
|
case span (/= '-') s of
|
||||||
(_, []) -> fail "invalid format, missing '-' after the tool name"
|
(_, []) -> fail "invalid format, missing '-' after the tool name"
|
||||||
(t, v) | [tool] <- [ tool | tool <- [minBound..maxBound], low (show tool) == low t ] ->
|
(t, v) | [tool] <- [ tool | tool <- [minBound..maxBound], low (show tool) == low t ] ->
|
||||||
pure (TarballFilter $ Right $ Just tool) <*> makeRegexOptsM compIgnoreCase execBlank (drop 1 v)
|
pure (TarballFilter $ Just tool) <*> makeRegexOptsM compIgnoreCase execBlank (drop 1 v)
|
||||||
(t, v) | [tool] <- [ tool | tool <- [minBound..maxBound], low (show tool) == low t ] ->
|
|
||||||
pure (TarballFilter $ Left tool) <*> makeRegexOptsM compIgnoreCase execBlank (drop 1 v)
|
|
||||||
_ -> fail "invalid tool"
|
_ -> fail "invalid tool"
|
||||||
low = fmap toLower
|
low = fmap toLower
|
||||||
|
|
||||||
@ -206,7 +204,7 @@ main = do
|
|||||||
flip runReaderT leanAppstate $ logError $ T.pack $ prettyShow e
|
flip runReaderT leanAppstate $ logError $ T.pack $ prettyShow e
|
||||||
liftIO $ exitWith (ExitFailure 2)
|
liftIO $ exitWith (ExitFailure 2)
|
||||||
|
|
||||||
let appstate = AppState (Settings True 0 Lax False Never Curl True GHCupURL False GPGNone True Nothing (DM mempty)) dirs defaultKeyBindings (GHCupInfo mempty mempty mempty) pfreq loggerConfig
|
let appstate = AppState (Settings True 0 Lax False Never Curl True GHCupURL False GPGNone True Nothing (DM mempty)) dirs defaultKeyBindings (GHCupInfo mempty mempty Nothing) pfreq loggerConfig
|
||||||
|
|
||||||
let withValidateYamlOpts vopts f = case vopts of
|
let withValidateYamlOpts vopts f = case vopts of
|
||||||
ValidateYAMLOpts { vInput = Nothing } ->
|
ValidateYAMLOpts { vInput = Nothing } ->
|
||||||
|
@ -207,7 +207,7 @@ validate distroChannel = do
|
|||||||
isBase _ = False
|
isBase _ = False
|
||||||
|
|
||||||
data TarballFilter = TarballFilter
|
data TarballFilter = TarballFilter
|
||||||
{ tfTool :: Either GlobalTool (Maybe Tool)
|
{ tfTool :: Maybe Tool
|
||||||
, tfVersion :: Regex
|
, tfVersion :: Regex
|
||||||
}
|
}
|
||||||
|
|
||||||
@ -226,20 +226,16 @@ validateTarballs :: ( Monad m
|
|||||||
)
|
)
|
||||||
=> TarballFilter
|
=> TarballFilter
|
||||||
-> m ExitCode
|
-> m ExitCode
|
||||||
validateTarballs (TarballFilter etool versionRegex) = do
|
validateTarballs (TarballFilter mtool versionRegex) = do
|
||||||
GHCupInfo { _ghcupDownloads = dls, _globalTools = gt } <- getGHCupInfo
|
GHCupInfo { _ghcupDownloads = dls } <- getGHCupInfo
|
||||||
ref <- liftIO $ newIORef 0
|
ref <- liftIO $ newIORef 0
|
||||||
|
|
||||||
-- download/verify all tarballs
|
-- download/verify all tarballs
|
||||||
let dlis = either (const []) (\tool -> nubOrd $ dls ^.. each %& indices (maybe (const True) (==) tool)
|
let dlis = nubOrd $ dls ^.. each %& indices (maybe (const True) (==) mtool)
|
||||||
%> each %& indices (matchTest versionRegex . T.unpack . prettyVer . _tvVersion)
|
%> each %& indices (matchTest versionRegex . T.unpack . prettyVer . _tvVersion)
|
||||||
% (viTestDL % _Just `summing` viSourceDL % _Just `summing` viArch % each % each % each)
|
% (viTestDL % _Just `summing` viSourceDL % _Just `summing` viArch % each % each % each)
|
||||||
)
|
when (null dlis) $ logError "no tarballs selected by filter" *> runReaderT addError ref
|
||||||
etool
|
forM_ dlis (downloadAll ref)
|
||||||
let gdlis = nubOrd $ gt ^.. each
|
|
||||||
let allDls = either (const gdlis) (const dlis) etool
|
|
||||||
when (null allDls) $ logError "no tarballs selected by filter" *> runReaderT addError ref
|
|
||||||
forM_ allDls (downloadAll ref)
|
|
||||||
|
|
||||||
-- exit
|
-- exit
|
||||||
e <- liftIO $ readIORef ref
|
e <- liftIO $ readIORef ref
|
||||||
@ -273,20 +269,16 @@ validateTarballs (TarballFilter etool versionRegex) = do
|
|||||||
, ContentLengthError
|
, ContentLengthError
|
||||||
]
|
]
|
||||||
$ do
|
$ do
|
||||||
case etool of
|
case mtool of
|
||||||
Right (Just GHCup) -> do
|
(Just GHCup) -> do
|
||||||
tmpUnpack <- lift mkGhcupTmpDir
|
tmpUnpack <- lift mkGhcupTmpDir
|
||||||
_ <- liftE $ download (_dlUri dli) Nothing (Just (_dlHash dli)) Nothing (fromGHCupPath tmpUnpack) Nothing False
|
_ <- liftE $ download (_dlUri dli) Nothing (Just (_dlHash dli)) Nothing (fromGHCupPath tmpUnpack) Nothing False
|
||||||
pure Nothing
|
pure Nothing
|
||||||
Right _ -> do
|
_ -> do
|
||||||
p <- liftE $ downloadCached dli Nothing
|
p <- liftE $ downloadCached dli Nothing
|
||||||
fmap Just $ liftE
|
fmap Just $ liftE
|
||||||
. getArchiveFiles
|
. getArchiveFiles
|
||||||
$ p
|
$ p
|
||||||
Left ShimGen -> do
|
|
||||||
tmpUnpack <- lift mkGhcupTmpDir
|
|
||||||
_ <- liftE $ download (_dlUri dli) Nothing (Just (_dlHash dli)) Nothing (fromGHCupPath tmpUnpack) Nothing False
|
|
||||||
pure Nothing
|
|
||||||
case r of
|
case r of
|
||||||
VRight (Just entries) -> do
|
VRight (Just entries) -> do
|
||||||
case _dlSubdir dli of
|
case _dlSubdir dli of
|
||||||
|
@ -65,5 +65,5 @@ executable ghcup-gen
|
|||||||
, safe-exceptions ^>=0.1
|
, safe-exceptions ^>=0.1
|
||||||
, text ^>=2.0
|
, text ^>=2.0
|
||||||
, transformers ^>=0.5
|
, transformers ^>=0.5
|
||||||
, versions >=4.0.1 && <5.1
|
, versions >=6.0.0
|
||||||
, yaml-streamly ^>=0.12.0
|
, yaml-streamly ^>=0.12.0
|
||||||
|
Loading…
Reference in New Issue
Block a user