Implemented automatic undeprecation of previously deprecated packages, also:

* Made sure update of deprecated is done each run, independently of Hackage update
This commit is contained in:
Alexey Kuleshevich 2019-07-29 19:36:57 +03:00
parent 537a295bfb
commit cbfb68bdc8
No known key found for this signature in database
GPG Key ID: E59B216127119E3E
2 changed files with 13 additions and 4 deletions

View File

@ -218,10 +218,10 @@ runStackageUpdate doNotUpload = do
runStackageMigrations
didUpdate <- forceUpdateHackageIndex (Just "stackage-server cron job")
case didUpdate of
UpdateOccurred -> do
logInfo "Updated hackage index. Getting deprecated info now"
getHackageDeprecations >>= run . mapM_ addDeprecated
UpdateOccurred -> logInfo "Updated hackage index"
NoUpdateOccurred -> logInfo "No new packages in hackage index"
logInfo "Getting deprecated info now"
getHackageDeprecations >>= setDeprecations
corePackageGetters <- makeCorePackageGetters
runResourceT $
join $

View File

@ -1,6 +1,7 @@
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}
module Stackage.Database.Query
(
@ -44,6 +45,7 @@ module Stackage.Database.Query
-- ** Deprecations
, getDeprecated
, setDeprecations
-- * Needed for Cron Job
-- ** Re-exports from Pantry
@ -56,7 +58,6 @@ module Stackage.Database.Query
, getHackageCabalByKey
, snapshotMarkUpdated
, insertSnapshotName
, addDeprecated
, markModuleHasDocs
, insertSnapshotPackageModules
, insertDeps
@ -874,6 +875,8 @@ lookupPackageNameId pname = fmap entityKey <$> getBy (UniquePackageName pname)
lookupPackageNameById :: PackageNameId -> ReaderT SqlBackend (RIO env) (Maybe PackageNameP)
lookupPackageNameById pnid = fmap PackageNameP <$> getPackageNameById pnid
-- | Add or updates package deprecation and its "in favor" list. Returns the Id if package
-- was found in pantry.
addDeprecated :: HasLogFunc env => Deprecation -> ReaderT SqlBackend (RIO env) ()
addDeprecated (Deprecation pname inFavourOfNameSet) = do
mPackageNameId <- lookupPackageNameId pname
@ -903,6 +906,12 @@ addDeprecated (Deprecation pname inFavourOfNameSet) = do
logError $
"Package name: " <> display pname <> " from deprecation list was not found in Pantry."
-- | In a single transaction clear out all deprecatons and add the new ones.
setDeprecations :: GetStackageDatabase env m => [Deprecation] -> m ()
setDeprecations deprecations = run $ do
delete $ from $ \(_deprecation :: SqlExpr (Entity Deprecated)) -> pure ()
mapM_ addDeprecated deprecations
getHackageCabalByRev0 ::
PackageIdentifierP