mirror of
https://github.com/commercialhaskell/stackage-server.git
synced 2026-01-12 12:18:29 +01:00
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:
parent
537a295bfb
commit
cbfb68bdc8
@ -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 $
|
||||||
|
|||||||
@ -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
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user