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 runStackageMigrations
didUpdate <- forceUpdateHackageIndex (Just "stackage-server cron job") didUpdate <- forceUpdateHackageIndex (Just "stackage-server cron job")
case didUpdate of case didUpdate of
UpdateOccurred -> do UpdateOccurred -> logInfo "Updated hackage index"
logInfo "Updated hackage index. Getting deprecated info now"
getHackageDeprecations >>= run . mapM_ addDeprecated
NoUpdateOccurred -> logInfo "No new packages in hackage index" NoUpdateOccurred -> logInfo "No new packages in hackage index"
logInfo "Getting deprecated info now"
getHackageDeprecations >>= setDeprecations
corePackageGetters <- makeCorePackageGetters corePackageGetters <- makeCorePackageGetters
runResourceT $ runResourceT $
join $ join $

View File

@ -1,6 +1,7 @@
{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE LambdaCase #-} {-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-} {-# LANGUAGE TupleSections #-}
module Stackage.Database.Query module Stackage.Database.Query
( (
@ -44,6 +45,7 @@ module Stackage.Database.Query
-- ** Deprecations -- ** Deprecations
, getDeprecated , getDeprecated
, setDeprecations
-- * Needed for Cron Job -- * Needed for Cron Job
-- ** Re-exports from Pantry -- ** Re-exports from Pantry
@ -56,7 +58,6 @@ module Stackage.Database.Query
, getHackageCabalByKey , getHackageCabalByKey
, snapshotMarkUpdated , snapshotMarkUpdated
, insertSnapshotName , insertSnapshotName
, addDeprecated
, markModuleHasDocs , markModuleHasDocs
, insertSnapshotPackageModules , insertSnapshotPackageModules
, insertDeps , insertDeps
@ -874,6 +875,8 @@ lookupPackageNameId pname = fmap entityKey <$> getBy (UniquePackageName pname)
lookupPackageNameById :: PackageNameId -> ReaderT SqlBackend (RIO env) (Maybe PackageNameP) lookupPackageNameById :: PackageNameId -> ReaderT SqlBackend (RIO env) (Maybe PackageNameP)
lookupPackageNameById pnid = fmap PackageNameP <$> getPackageNameById pnid 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 :: HasLogFunc env => Deprecation -> ReaderT SqlBackend (RIO env) ()
addDeprecated (Deprecation pname inFavourOfNameSet) = do addDeprecated (Deprecation pname inFavourOfNameSet) = do
mPackageNameId <- lookupPackageNameId pname mPackageNameId <- lookupPackageNameId pname
@ -903,6 +906,12 @@ addDeprecated (Deprecation pname inFavourOfNameSet) = do
logError $ logError $
"Package name: " <> display pname <> " from deprecation list was not found in Pantry." "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 :: getHackageCabalByRev0 ::
PackageIdentifierP PackageIdentifierP