Modularise requirements query

flora-pm · Dec 23, 2023 · df51ba9 · df51ba9
1 parent 5297962
commit df51ba9
Showing 3 changed files with 69 additions and 29 deletions.
diff --git a/src/core/Flora/Model/Component/Query.hs b/src/core/Flora/Model/Component/Query.hs
@@ -1,9 +1,7 @@
 {-# LANGUAGE OverloadedLists #-}
 {-# LANGUAGE QuasiQuotes #-}
 
-module Flora.Model.Component.Query
-  ( getComponentsByReleaseId
-  ) where
+module Flora.Model.Component.Query (getComponentsByReleaseId) where
 
 import Data.Text
 import Data.Vector (Vector)
@@ -13,10 +11,10 @@ import Database.PostgreSQL.Entity.DBT
   , query
   )
 import Database.PostgreSQL.Entity.Types
+import Database.PostgreSQL.Simple (Only (..))
 import Effectful
 import Effectful.PostgreSQL.Transact.Effect
 
-import Database.PostgreSQL.Simple (Only (..))
 import Flora.Model.Component.Types
 import Flora.Model.Release.Types (ReleaseId)
 
@@ -28,6 +26,7 @@ getComponentsByReleaseId releaseId = do
         Select
         ( _selectWithFields @PackageComponent
             [[field| component_name |], [field| component_type |]]
+            <> _where [[field| release_id |]]
         )
         (Only releaseId)
   pure $ fmap (uncurry CanonicalComponent) results
diff --git a/src/core/Flora/Model/Package/Query.hs b/src/core/Flora/Model/Package/Query.hs
@@ -6,6 +6,7 @@ module Flora.Model.Package.Query
   , countPackagesByName
   , countPackagesInNamespace
   , getAllPackageDependents
+  , getRequirementsQuery
   , getAllPackageDependentsWithLatestVersion
   , getAllPackages
   , getAllRequirements
@@ -33,6 +34,7 @@ module Flora.Model.Package.Query
 import Data.Text (Text)
 import Data.Text.Display (display)
 import Data.Vector (Vector)
+import Data.Vector qualified as Vector
 import Database.PostgreSQL.Entity
   ( joinSelectOneByField
   , selectById
@@ -60,12 +62,9 @@ import Log qualified
 import Flora.Logging (timeAction)
 import Flora.Model.Category (Category, CategoryId)
 import Flora.Model.Category.Types (PackageCategory)
+import Flora.Model.Component.Query qualified as Query
 import Flora.Model.Component.Types
-  ( ComponentId
-  , ComponentType
-  , PackageComponent
-  )
-import Flora.Model.Package (Namespace (..), Package, PackageId, PackageInfo, PackageName)
+import Flora.Model.Package (Namespace (..), Package, PackageId, PackageInfo, PackageName (..))
 import Flora.Model.Release.Types (ReleaseId)
 import Flora.Model.Requirement
   ( ComponentDependencies
@@ -323,9 +322,19 @@ getAllRequirements
   -> Eff es ComponentDependencies
 getAllRequirements releaseId = dbtToEff $ toComponentDependencies <$> query Select getAllRequirementsQuery (Only releaseId)
 
-getRequirements :: (DB :> es, Log :> es, Time :> es) => ReleaseId -> Eff es (Vector (Namespace, PackageName, Text))
-getRequirements releaseId = do
-  (result, duration) <- timeAction $ dbtToEff $ query Select (getRequirementsQuery <> " LIMIT 6") (Only releaseId)
+getRequirements
+  :: (DB :> es, Log :> es, Time :> es)
+  => PackageName
+  -> ReleaseId
+  -> Eff es (Vector (Namespace, PackageName, Text))
+getRequirements (PackageName packageName) releaseId = do
+  components <- Query.getComponentsByReleaseId releaseId
+  (result, duration) <-
+    case Vector.find (\CanonicalComponent{componentName} -> componentName == packageName) components of
+      Just (CanonicalComponent{componentType}) ->
+        timeAction $ dbtToEff $ query Select (getRequirementsQuery True <> " LIMIT 6") (componentType, releaseId)
+      Nothing ->
+        timeAction $ dbtToEff $ query Select (getRequirementsQuery False <> " LIMIT 6") (Only releaseId)
   Log.logInfo "Retrieving limited dependencies of a release" $
     object
       [ "duration" .= duration
@@ -373,22 +382,54 @@ WITH requirements AS (SELECT DISTINCT p1.component_type
 |]
 
 -- | This query provides a limited view of the dependencies of a release.
-getRequirementsQuery :: Query
-getRequirementsQuery =
-  [sql|
-SELECT DISTINCT dependency.namespace
-              , dependency.name
-              , req.requirement
-FROM requirements AS req
-     INNER JOIN packages AS dependency ON dependency.package_id = req.package_id
-     INNER JOIN package_components AS pc ON pc.package_component_id = req.package_component_id
-                                        AND pc.component_type = 'library'
-     INNER JOIN releases AS rel ON rel.release_id = pc.release_id
-     INNER JOIN packages AS dependent ON rel.package_id = dependent.package_id
-WHERE rel.release_id = ?
-  AND pc.component_name = dependent.name
-ORDER BY dependency.namespace DESC
-|]
+getRequirementsQuery
+  :: Bool
+  -- Single component type?
+  -> Query
+getRequirementsQuery singleComponentType =
+  selectors
+    <> if singleComponentType
+      then tablesSingleType
+      else
+        tablesManyTypes
+          <> whereClause
+          <> orderClause
+  where
+    selectors =
+      [sql|
+      SELECT DISTINCT dependency.namespace
+                    , dependency.name
+                    , req.requirement
+
+      |]
+    tablesSingleType =
+      [sql|
+      FROM requirements AS req
+           INNER JOIN packages AS dependency ON dependency.package_id = req.package_id
+           INNER JOIN package_components AS pc ON pc.package_component_id = req.package_component_id
+                                              AND pc.component_type = ?
+           INNER JOIN releases AS rel ON rel.release_id = pc.release_id
+           INNER JOIN packages AS dependent ON rel.package_id = dependent.package_id
+      |]
+    tablesManyTypes =
+      [sql|
+      FROM requirements AS req
+           INNER JOIN packages AS dependency ON dependency.package_id = req.package_id
+           INNER JOIN package_components AS pc ON pc.package_component_id = req.package_component_id
+           INNER JOIN releases AS rel ON rel.release_id = pc.release_id
+           INNER JOIN packages AS dependent ON rel.package_id = dependent.package_id
+      |]
+
+    whereClause =
+      [sql|
+      WHERE rel.release_id = ?
+        AND pc.component_name = dependent.name
+      |]
+
+    orderClause =
+      [sql|
+      ORDER BY dependency.namespace DESC
+      |]
 
 getNumberOfPackageRequirements :: DB :> es => ReleaseId -> Eff es Word
 getNumberOfPackageRequirements releaseId =

diff --git a/src/web/FloraWeb/Pages/Server/Packages.hs b/src/web/FloraWeb/Pages/Server/Packages.hs
@@ -128,7 +128,7 @@ showPackageVersion namespace packageName mversion = do
   release <- guardThatReleaseExists package.packageId version $ const web404
   numberOfReleases <- Query.getNumberOfReleases package.packageId
   dependents <- Query.getPackageDependents namespace packageName
-  releaseDependencies <- Query.getRequirements release.releaseId
+  releaseDependencies <- Query.getRequirements package.name release.releaseId
   categories <- Query.getPackageCategories package.packageId
   numberOfDependents <- Query.getNumberOfPackageDependents namespace packageName Nothing
   numberOfDependencies <- Query.getNumberOfPackageRequirements release.releaseId