From 340cefe283da264411a57c585c4c48f017153436 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Th=C3=A9ophile=20Choutri?= Date: Mon, 20 May 2024 14:06:32 +0200 Subject: [PATCH 1/2] [FLORA-67] Log and re-import packages with zero dependencies --- src/core/Flora/Import/Package.hs | 64 ++++++++++++++------------ src/core/Flora/Import/Package/Types.hs | 10 ++-- 2 files changed, 41 insertions(+), 33 deletions(-) diff --git a/src/core/Flora/Import/Package.hs b/src/core/Flora/Import/Package.hs index cdc1f08a..295d21ca 100644 --- a/src/core/Flora/Import/Package.hs +++ b/src/core/Flora/Import/Package.hs @@ -70,12 +70,15 @@ import Effectful.Poolboy qualified as Poolboy import Effectful.PostgreSQL.Transact.Effect (DB, getPool) import Effectful.Time (Time) import Effectful.Time qualified as Time +import GHC.List (List) import Log qualified import OddJobs.Job (createJob) import Optics.Core import System.Directory qualified as System import Control.Monad (forM_, unless, void) +import Data.Aeson (object, (.=)) +import Data.List.NonEmpty qualified as NE import Flora.Import.Categories.Tuning qualified as Tuning import Flora.Import.Package.Types import Flora.Import.Types @@ -252,15 +255,15 @@ persistImportOutput (ImportOutput package categories release components) = do parallelRun persistComponent components liftIO $ putStr "\n" where - parallelRun :: (a -> Eff es ()) -> [a] -> Eff es () - parallelRun f xs = forM_ xs (\x -> void $ Poolboy.enqueue (f x)) + parallelRun :: Foldable t => (a -> Eff es ()) -> t a -> Eff es () + parallelRun f xs = forM_ xs (Poolboy.enqueue . f) packageName = display package.namespace <> "/" <> display package.name persistPackage = do let packageId = package.packageId Update.upsertPackage package forM_ categories (\case Tuning.NormalisedPackageCategory cat -> Update.addToCategoryByName packageId cat) - persistComponent :: (PackageComponent, [ImportDependency]) -> Eff es () + persistComponent :: (PackageComponent, List ImportDependency) -> Eff es () persistComponent (packageComponent, deps) = do liftIO . T.putStrLn $ "🧩 Persisting component: " @@ -280,7 +283,7 @@ persistImportOutput (ImportOutput package categories release components) = do -- that can later be inserted into the database. This function produces stable, deterministic ids, -- so it should be possible to extract and insert a single package many times in a row. extractPackageDataFromCabal - :: (IOE :> es, Time :> es) + :: (IOE :> es, Time :> es, Log :> es) => UserId -> (Text, Set PackageName) -> UTCTime @@ -359,7 +362,7 @@ extractPackageDataFromCabal userId (repositoryName, repositoryPackages) uploadTi let benchmarks = extractBenchmark package (repositoryName, repositoryPackages) release Nothing [] <$> packageDesc.benchmarks let condBenchmarks = extractCondTrees extractBenchmark package (repositoryName, repositoryPackages) release genericDesc.condBenchmarks - let components = + let components' = lib <> condLib <> condSubLibs @@ -371,23 +374,26 @@ extractPackageDataFromCabal userId (repositoryName, repositoryPackages) uploadTi <> condTestSuites <> benchmarks <> condBenchmarks - pure ImportOutput{..} + case NE.nonEmpty components' of + Nothing -> do + Log.logAttention "Empty dependencies" $ object ["package" .= package] + extractPackageDataFromCabal userId (repositoryName, repositoryPackages) uploadTime genericDesc + Just components -> pure ImportOutput{..} extractLibrary :: Package -> (Text, Set PackageName) -> Release -> Maybe UnqualComponentName - -> [Condition ConfVar] + -> List (Condition ConfVar) -> Library - -> ImportComponent -extractLibrary package repository = + -> (PackageComponent, List ImportDependency) +extractLibrary package = genericComponentExtractor Component.Library (^. #libName % to (getLibName package.name)) (^. #libBuildInfo % #targetBuildDepends) package - repository getLibName :: PackageName -> LibraryName -> Text getLibName pname LMainLibName = display pname @@ -398,9 +404,9 @@ extractForeignLib -> (Text, Set PackageName) -> Release -> Maybe UnqualComponentName - -> [Condition ConfVar] + -> List (Condition ConfVar) -> ForeignLib - -> ImportComponent + -> (PackageComponent, List ImportDependency) extractForeignLib = genericComponentExtractor Component.ForeignLib @@ -412,9 +418,9 @@ extractExecutable -> (Text, Set PackageName) -> Release -> Maybe UnqualComponentName - -> [Condition ConfVar] + -> List (Condition ConfVar) -> Executable - -> ImportComponent + -> (PackageComponent, List ImportDependency) extractExecutable = genericComponentExtractor Component.Executable @@ -426,9 +432,9 @@ extractTestSuite -> (Text, Set PackageName) -> Release -> Maybe UnqualComponentName - -> [Condition ConfVar] + -> List (Condition ConfVar) -> TestSuite - -> ImportComponent + -> (PackageComponent, List ImportDependency) extractTestSuite = genericComponentExtractor Component.TestSuite @@ -440,9 +446,9 @@ extractBenchmark -> (Text, Set PackageName) -> Release -> Maybe UnqualComponentName - -> [Condition ConfVar] + -> List (Condition ConfVar) -> Benchmark - -> ImportComponent + -> (PackageComponent, List ImportDependency) extractBenchmark = genericComponentExtractor Component.Benchmark @@ -450,15 +456,15 @@ extractBenchmark = (^. #benchmarkBuildInfo % #targetBuildDepends) -- | Traverses the provided 'CondTree' and applies the given 'ComponentExtractor' --- to every node, returning a list of 'ImportComponent' +-- to every node, returning a list of '(PackageComponent, List ImportDependency)' extractCondTree - :: (Package -> (Text, Set PackageName) -> Release -> Maybe UnqualComponentName -> [Condition ConfVar] -> component -> ImportComponent) + :: (Package -> (Text, Set PackageName) -> Release -> Maybe UnqualComponentName -> List (Condition ConfVar) -> component -> (PackageComponent, List ImportDependency)) -> Package -> (Text, Set PackageName) -> Release -> Maybe UnqualComponentName - -> CondTree ConfVar [Dependency] component - -> [ImportComponent] + -> CondTree ConfVar (List Dependency) component + -> List (PackageComponent, List ImportDependency) extractCondTree extractor package repository release defaultComponentName = go [] where go cond tree = @@ -474,12 +480,12 @@ extractCondTree extractor package repository release defaultComponentName = go [ -- This function builds upon 'extractCondTree' to make it easier to extract fields such as 'condExecutables', 'condTestSuites' etc. -- from a 'GenericPackageDescription' extractCondTrees - :: (Package -> (Text, Set PackageName) -> Release -> Maybe UnqualComponentName -> [Condition ConfVar] -> component -> ImportComponent) + :: (Package -> (Text, Set PackageName) -> Release -> Maybe UnqualComponentName -> List (Condition ConfVar) -> component -> (PackageComponent, List ImportDependency)) -> Package -> (Text, Set PackageName) -> Release - -> [(UnqualComponentName, CondTree ConfVar [Dependency] component)] - -> [ImportComponent] + -> List (UnqualComponentName, CondTree ConfVar (List Dependency) component) + -> List (PackageComponent, List ImportDependency) extractCondTrees extractor package repository release trees = trees >>= \case (name, tree) -> extractCondTree extractor package repository release (Just name) tree @@ -489,15 +495,15 @@ genericComponentExtractor => ComponentType -> (component -> Text) -- ^ Extract name from component - -> (component -> [Dependency]) + -> (component -> List Dependency) -- ^ Extract dependencies -> Package -> (Text, Set PackageName) -> Release -> Maybe UnqualComponentName - -> [Condition ConfVar] + -> List (Condition ConfVar) -> component - -> (PackageComponent, [ImportDependency]) + -> (PackageComponent, List ImportDependency) genericComponentExtractor componentType getName @@ -543,7 +549,7 @@ buildDependency package (repository, repositoryPackages) packageComponentId (Cab } in ImportDependency{package = dependencyPackage, requirement} -getRepoURL :: PackageName -> [Cabal.SourceRepo] -> Vector Text +getRepoURL :: PackageName -> List Cabal.SourceRepo -> Vector Text getRepoURL _ [] = Vector.empty getRepoURL _ (repo : _) = Vector.singleton $ display $ fromMaybe mempty repo.repoLocation diff --git a/src/core/Flora/Import/Package/Types.hs b/src/core/Flora/Import/Package/Types.hs index 707c6154..f3e4741f 100644 --- a/src/core/Flora/Import/Package/Types.hs +++ b/src/core/Flora/Import/Package/Types.hs @@ -2,15 +2,17 @@ module Flora.Import.Package.Types where import Control.DeepSeq import Data.Aeson +import Data.List.NonEmpty (NonEmpty) +import GHC.Generics +import GHC.List (List) + import Flora.Import.Categories.Tuning qualified as Tuning import Flora.Model.Component.Types import Flora.Model.Package.Types import Flora.Model.Release.Types import Flora.Model.Requirement -import GHC.Generics - -type ImportComponent = (PackageComponent, [ImportDependency]) +-- | Package being depended on and its requirement constraint. data ImportDependency = ImportDependency { package :: Package -- ^ the package that is being depended on. Must be inserted in the DB before the requirement @@ -28,7 +30,7 @@ data ImportOutput = ImportOutput { package :: Package , categories :: [Tuning.NormalisedPackageCategory] , release :: Release - , components :: [ImportComponent] + , components :: NonEmpty (PackageComponent, List ImportDependency) } deriving stock (Eq, Show, Generic) deriving anyclass (FromJSON, ToJSON) From 0e143400e19b94288797812d0380da4982b85556 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Th=C3=A9ophile=20Choutri?= Date: Mon, 20 May 2024 14:09:48 +0200 Subject: [PATCH 2/2] Add changelog entry --- changelog.d/553 | 3 +++ 1 file changed, 3 insertions(+) create mode 100644 changelog.d/553 diff --git a/changelog.d/553 b/changelog.d/553 new file mode 100644 index 00000000..bc2d3568 --- /dev/null +++ b/changelog.d/553 @@ -0,0 +1,3 @@ +synopsis: Log and re-import packages with zero dependencies +prs: #553 +significant: significant