diff --git a/app/ghcup/Main.hs b/app/ghcup/Main.hs index ef4c404..f2646fa 100644 --- a/app/ghcup/Main.hs +++ b/app/ghcup/Main.hs @@ -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 diff --git a/lib/GHCup/Download.hs b/lib/GHCup/Download.hs index ce6a2f9..dc6f633 100644 --- a/lib/GHCup/Download.hs +++ b/lib/GHCup/Download.hs @@ -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