Just use the cache for commands which refer to locally stored objects.
Setting a version of GHC will fail if provided with a version not installed, and we don't neede to check the most recent list of GHCs available to know that.
This commit is contained in:
Huw campbell
Huw Campbell
parent
d6fa61e223
commit
1a5f0259f4
|
|
@ -495,7 +495,7 @@ installOpts tool =
|
|||
)
|
||||
)
|
||||
)
|
||||
<*> (Just <$> toolVersionArgument Nothing tool)
|
||||
<*> (Just <$> toolVersionArgument True Nothing tool)
|
||||
)
|
||||
<|> (pure (Nothing, Nothing))
|
||||
)
|
||||
|
|
@ -560,7 +560,7 @@ setParser =
|
|||
|
||||
|
||||
setOpts :: Maybe Tool -> Parser SetOptions
|
||||
setOpts tool = SetOptions <$> optional (toolVersionArgument (Just ListInstalled) tool)
|
||||
setOpts tool = SetOptions <$> optional (toolVersionArgument False (Just ListInstalled) tool)
|
||||
|
||||
listOpts :: Parser ListOptions
|
||||
listOpts =
|
||||
|
|
@ -614,7 +614,7 @@ rmParser =
|
|||
|
||||
|
||||
rmOpts :: Maybe Tool -> Parser RmOptions
|
||||
rmOpts tool = RmOptions <$> versionArgument (Just ListInstalled) tool
|
||||
rmOpts tool = RmOptions <$> versionArgument False (Just ListInstalled) tool
|
||||
|
||||
|
||||
changelogP :: Parser ChangeLogOptions
|
||||
|
|
@ -636,7 +636,7 @@ changelogP =
|
|||
)
|
||||
)
|
||||
)
|
||||
<*> optional (toolVersionArgument Nothing Nothing)
|
||||
<*> optional (toolVersionArgument True Nothing Nothing)
|
||||
|
||||
compileP :: Parser CompileCommand
|
||||
compileP = subparser
|
||||
|
|
@ -765,13 +765,13 @@ toolVersionParser = verP' <|> toolP
|
|||
)
|
||||
|
||||
-- | same as toolVersionParser, except as an argument.
|
||||
toolVersionArgument :: Maybe ListCriteria -> Maybe Tool -> Parser ToolVersion
|
||||
toolVersionArgument criterial tool =
|
||||
argument (eitherReader toolVersionEither) (metavar "VERSION|TAG" <> completer tagCompleter <> foldMap (completer . versionCompleter criterial) tool)
|
||||
toolVersionArgument :: Bool -> Maybe ListCriteria -> Maybe Tool -> Parser ToolVersion
|
||||
toolVersionArgument networkSensitive criteria tool =
|
||||
argument (eitherReader toolVersionEither) (metavar "VERSION|TAG" <> completer tagCompleter <> foldMap (completer . versionCompleter networkSensitive criteria) tool)
|
||||
|
||||
|
||||
versionArgument :: Maybe ListCriteria -> Maybe Tool -> Parser GHCTargetVersion
|
||||
versionArgument criterial tool = argument (eitherReader tVersionEither) (metavar "VERSION" <> foldMap (completer . versionCompleter criterial) tool)
|
||||
versionArgument :: Bool -> Maybe ListCriteria -> Maybe Tool -> Parser GHCTargetVersion
|
||||
versionArgument networkSensitive criteria tool = argument (eitherReader tVersionEither) (metavar "VERSION" <> foldMap (completer . versionCompleter networkSensitive criteria) tool)
|
||||
|
||||
|
||||
tagCompleter :: Completer
|
||||
|
|
@ -781,8 +781,8 @@ tagCompleter =
|
|||
]
|
||||
|
||||
|
||||
versionCompleter :: Maybe ListCriteria -> Tool -> Completer
|
||||
versionCompleter criteria tool =
|
||||
versionCompleter :: Bool -> Maybe ListCriteria -> Tool -> Completer
|
||||
versionCompleter networkSensitive criteria tool =
|
||||
listIOCompleter $ do
|
||||
let
|
||||
loggerConfig =
|
||||
|
|
@ -811,8 +811,12 @@ versionCompleter criteria tool =
|
|||
|
||||
mGhcUpInfo <-
|
||||
runEnv . runE $
|
||||
getDownloadsF $
|
||||
urlSource simpleSettings
|
||||
if networkSensitive then
|
||||
getDownloadsF GHCupURL
|
||||
else
|
||||
catchE
|
||||
(\(FileDoesNotExistError _) -> getDownloadsF GHCupURL)
|
||||
readFromCache
|
||||
|
||||
forFold mGhcUpInfo $ \(GHCupInfo _ dls) -> do
|
||||
installedVersions <-
|
||||
|
|
@ -831,7 +835,7 @@ versionParser = option
|
|||
|
||||
versionParser' :: Parser Version
|
||||
versionParser' = argument
|
||||
(eitherReader (bimap show id . version . T.pack))
|
||||
(eitherReader (first show . version . T.pack))
|
||||
(metavar "VERSION")
|
||||
|
||||
|
||||
|
|
@ -842,7 +846,7 @@ tagEither s' = case fmap toLower s' of
|
|||
('b':'a':'s':'e':'-':ver') -> case pvp (T.pack ver') of
|
||||
Right x -> Right (Base x)
|
||||
Left _ -> Left [i|Invalid PVP version for base #{ver'}|]
|
||||
other -> Left ([i|Unknown tag #{other}|])
|
||||
other -> Left [i|Unknown tag #{other}|]
|
||||
|
||||
|
||||
tVersionEither :: String -> Either String GHCTargetVersion
|
||||
|
|
|
|||
|
|
@ -137,30 +137,8 @@ getDownloadsF urlSource = do
|
|||
bsExt <- reThrowAll DownloadFailed $ downloadBS uri
|
||||
ext <- lE' JSONDecodeError $ bimap show id $ Y.decodeEither' (L.toStrict bsExt)
|
||||
pure (mergeGhcupInfo base ext)
|
||||
where
|
||||
readFromCache :: (MonadIO m, MonadCatch m, MonadLogger m, MonadReader AppState m)
|
||||
=> Excepts '[JSONError, FileDoesNotExistError] m GHCupInfo
|
||||
readFromCache = do
|
||||
AppState {dirs = Dirs {..}} <- lift ask
|
||||
lift $ $(logWarn)
|
||||
[i|Could not get download info, trying cached version (this may not be recent!)|]
|
||||
let path = view pathL' ghcupURL
|
||||
yaml_file <- (cacheDir </>) <$> urlBaseName path
|
||||
bs <-
|
||||
handleIO' NoSuchThing
|
||||
(\_ -> throwE $ FileDoesNotExistError (toFilePath yaml_file))
|
||||
$ liftIO
|
||||
$ readFile yaml_file
|
||||
lE' JSONDecodeError $ bimap show id $ Y.decodeEither' (L.toStrict bs)
|
||||
|
||||
getBase :: (MonadFail m, MonadIO m, MonadCatch m, MonadLogger m, MonadReader AppState m)
|
||||
=> Excepts '[JSONError , FileDoesNotExistError] m GHCupInfo
|
||||
getBase =
|
||||
handleIO (\_ -> readFromCache)
|
||||
$ catchE @_ @'[JSONError, FileDoesNotExistError]
|
||||
(\(DownloadFailed _) -> readFromCache)
|
||||
$ ((reThrowAll @_ @_ @'[JSONError, DownloadFailed] DownloadFailed $ smartDl ghcupURL)
|
||||
>>= (liftE . lE' @_ @_ @'[JSONError] JSONDecodeError . bimap show id . Y.decodeEither' . L.toStrict))
|
||||
where
|
||||
|
||||
mergeGhcupInfo :: GHCupInfo -- ^ base to merge with
|
||||
-> GHCupInfo -- ^ extension overwriting the base
|
||||
|
|
@ -172,6 +150,32 @@ getDownloadsF urlSource = do
|
|||
) base
|
||||
in GHCupInfo tr new
|
||||
|
||||
|
||||
readFromCache :: (MonadIO m, MonadCatch m, MonadLogger m, MonadReader AppState m)
|
||||
=> Excepts '[JSONError, FileDoesNotExistError] m GHCupInfo
|
||||
readFromCache = do
|
||||
AppState {dirs = Dirs {..}} <- lift ask
|
||||
lift $ $(logWarn)
|
||||
[i|Could not get download info, trying cached version (this may not be recent!)|]
|
||||
let path = view pathL' ghcupURL
|
||||
yaml_file <- (cacheDir </>) <$> urlBaseName path
|
||||
bs <-
|
||||
handleIO' NoSuchThing
|
||||
(\_ -> throwE $ FileDoesNotExistError (toFilePath yaml_file))
|
||||
$ liftIO
|
||||
$ readFile yaml_file
|
||||
lE' JSONDecodeError $ bimap show id $ Y.decodeEither' (L.toStrict bs)
|
||||
|
||||
|
||||
getBase :: (MonadFail m, MonadIO m, MonadCatch m, MonadLogger m, MonadReader AppState m)
|
||||
=> Excepts '[JSONError , FileDoesNotExistError] m GHCupInfo
|
||||
getBase =
|
||||
handleIO (\_ -> readFromCache)
|
||||
$ catchE @_ @'[JSONError, FileDoesNotExistError]
|
||||
(\(DownloadFailed _) -> readFromCache)
|
||||
$ ((reThrowAll @_ @_ @'[JSONError, DownloadFailed] DownloadFailed $ smartDl ghcupURL)
|
||||
>>= (liftE . lE' @_ @_ @'[JSONError] JSONDecodeError . bimap show id . Y.decodeEither' . L.toStrict))
|
||||
where
|
||||
-- First check if the json file is in the ~/.ghcup/cache dir
|
||||
-- and check it's access time. If it has been accessed within the
|
||||
-- last 5 minutes, just reuse it.
|
||||
|
|
@ -209,8 +213,8 @@ getDownloadsF urlSource = do
|
|||
then do
|
||||
accessTime <-
|
||||
PF.accessTimeHiRes
|
||||
<$> (liftIO $ PF.getFileStatus (toFilePath json_file))
|
||||
currentTime <- liftIO $ getPOSIXTime
|
||||
<$> liftIO (PF.getFileStatus (toFilePath json_file))
|
||||
currentTime <- liftIO getPOSIXTime
|
||||
|
||||
-- access time won't work on most linuxes, but we can try regardless
|
||||
if (currentTime - accessTime) > 300
|
||||
|
|
|
|||
Loading…
Reference in New Issue