Finish implementing depends: modifier

src/core/Flora/Model/Package/Query.hs

@@ -1,7 +1,34 @@
 {-# LANGUAGE OverloadedLists #-}
 {-# LANGUAGE QuasiQuotes #-}
 
-module Flora.Model.Package.Query where
+module Flora.Model.Package.Query
+  ( countPackages
+  , countPackagesByName
+  , countPackagesInNamespace
+  , getAllPackageDependents
+  , getAllPackageDependentsWithLatestVersion
+  , getAllPackages
+  , getAllRequirements
+  , getComponent
+  , getNonDeprecatedPackages
+  , getNumberOfPackageDependents
+  , getPackageByNamespaceAndName
+  , getPackageCategories
+  , getPackageDependents
+  , getPackageDependentsByName
+  , getPackageDependentsWithLatestVersion
+  , getPackagesByNamespace
+  , getPackagesFromCategoryWithLatestVersion
+  , getRequirements
+  , listAllPackages
+  , listAllPackagesInNamespace
+  , numberOfPackageRequirementsQuery
+  , searchPackage
+  , unsafeGetComponent
+  , getComponentById
+  , searchPackageByNamespace
+  , getNumberOfPackageRequirements
+  ) where
 
 import Data.Text (Text)
 import Data.Text.Display (display)
@@ -437,6 +464,40 @@ searchPackage (offset, limit) searchString =
         |]
       (searchString, searchString, offset, limit)
 
+searchPackageByNamespace
+  :: DB :> es
+  => (Word, Word)
+  -> Namespace
+  -> Text
+  -> Eff es (Vector PackageInfo)
+searchPackageByNamespace (offset, limit) namespace searchString =
+  dbtToEff $
+    query
+      Select
+      [sql|
+        SELECT  lv."namespace"
+              , lv."name"
+              , lv."synopsis"
+              , lv."version"
+              , lv."license"
+              , word_similarity(lv.name, ?) as rating
+        FROM latest_versions as lv
+        WHERE 
+        ? <% lv."name"
+        AND lv."namespace" = ?
+        GROUP BY
+            lv."namespace"
+          , lv."name"
+          , lv."synopsis"
+          , lv."version"
+          , lv."license"
+        ORDER BY rating desc, count(lv."namespace") desc, lv.name asc
+        OFFSET ?
+        LIMIT ?
+        ;
+        |]
+      (searchString, searchString, namespace, offset, limit)
+
 -- | Returns a summary of packages
 listAllPackages
   :: DB :> es

src/core/Flora/Search.hs

@@ -23,13 +23,20 @@ import Flora.Logging
 import Flora.Model.Package (Namespace (..), PackageInfo (..), PackageName (..), formatPackage)
 import Flora.Model.Package.Query qualified as Query
 import Flora.Model.Package.Types qualified as Package
+import Flora.Model.Requirement
 
 data SearchAction
   = ListAllPackages
   | ListAllPackagesInNamespace Namespace
   | SearchPackages Text
-  | DependentsOf Namespace PackageName (Maybe Text)
-  | SearchPackage Namespace PackageName
+  | DependentsOf
+      Namespace
+      -- ^ Namespace
+      PackageName
+      -- ^ Package 
+      (Maybe Text)
+      -- ^ Search within the package
+  | SearchInNamespace Namespace PackageName
   deriving (Eq, Ord, Show)
 
 instance Display SearchAction where
@@ -42,9 +49,23 @@ instance Display SearchAction where
       <> "/"
       <> displayBuilder packageName
       <> foldMap (\searchString -> " \"" <> Builder.fromText searchString <> "\"") mbSearchString
-  displayBuilder (SearchPackage namespace packageName) =
+  displayBuilder (SearchInNamespace namespace packageName) =
     "Package " <> displayBuilder namespace <> "/" <> displayBuilder packageName
 
+search
+  :: (DB :> es, Log :> es, Time :> es)
+  => (Word, Word)
+  -> Text
+  -> Eff es (Word, Vector PackageInfo)
+search pagination queryString =
+  case parseSearchQuery queryString of
+    Just (ListAllPackagesInNamespace namespace) -> listAllPackagesInNamespace pagination namespace
+    Just ListAllPackages -> listAllPackages pagination
+    Just (SearchInNamespace namespace (PackageName packageName)) -> searchPackageByNamespaceAndName pagination namespace packageName
+    Just (DependentsOf namespace packageName mSearchString) -> searchDependents pagination namespace packageName mSearchString
+    Just (SearchPackages _) -> searchPackageByName pagination queryString
+    Nothing -> searchPackageByName pagination queryString
+
 searchPackageByName
   :: (DB :> es, Log :> es, Time :> es)
   => (Word, Word)
@@ -72,13 +93,69 @@ searchPackageByName (offset, limit) queryString = do
   count <- Query.countPackagesByName queryString
   pure (count, results)
 
+searchPackageByNamespaceAndName
+  :: (DB :> es, Log :> es, Time :> es)
+  => (Word, Word)
+  -> Namespace
+  -> Text
+  -> Eff es (Word, Vector PackageInfo)
+searchPackageByNamespaceAndName (offset, limit) namespace queryString = do
+  (results, duration) <- timeAction $ Query.searchPackageByNamespace (offset, limit) namespace queryString
+
+  Log.logInfo "search-results" $
+    object
+      [ "search_string" .= queryString
+      , "duration" .= duration
+      , "results_count" .= Vector.length results
+      , "results"
+          .= List.map
+            ( \PackageInfo{name, rating} ->
+                object
+                  [ "package" .= formatPackage namespace name
+                  , "score" .= rating
+                  ]
+            )
+            (Vector.toList results)
+      ]
+
+  count <- Query.countPackagesByName queryString
+  pure (count, results)
+
+searchDependents
+  :: (DB :> es)
+  => (Word, Word)
+  -> Namespace
+  -> PackageName
+  -> Maybe Text
+  -> Eff es (Word, Vector PackageInfo)
+searchDependents pagination namespace packageName mSearchString = do
+  results <-
+    Query.getAllPackageDependentsWithLatestVersion
+      namespace
+      packageName
+      pagination
+      mSearchString
+  totalDependents <- Query.getNumberOfPackageDependents namespace packageName mSearchString
+  pure (totalDependents, fmap dependencyInfoToPackageInfo results)
+
+dependencyInfoToPackageInfo :: DependencyInfo -> PackageInfo
+dependencyInfoToPackageInfo dep = 
+  PackageInfo
+    dep.namespace
+    dep.name
+    dep.latestSynopsis
+    dep.latestVersion
+    dep.latestLicense
+    Nothing
+
+
 listAllPackagesInNamespace
   :: (DB :> es, Time :> es, Log :> es)
-  => Namespace
-  -> (Word, Word)
+  => (Word, Word)
+  -> Namespace
   -> Eff es (Word, Vector PackageInfo)
-listAllPackagesInNamespace namespace (offset, limit) = do
-  (results, duration) <- timeAction $ Query.listAllPackagesInNamespace (offset, limit) namespace
+listAllPackagesInNamespace pagination namespace = do
+  (results, duration) <- timeAction $ Query.listAllPackagesInNamespace pagination namespace
 
   Log.logInfo "packages-in-namespace" $
     object
@@ -124,7 +201,7 @@ parseSearchQuery = \case
   (Text.stripPrefix "in:" -> Just rest) ->
     case parseNamespaceAndPackageSearch rest of
       (Just namespace, Just packageName) ->
-        Just $ SearchPackage namespace packageName
+        Just $ SearchInNamespace namespace packageName
       (Just namespace, Nothing) ->
         Just $ ListAllPackagesInNamespace namespace
       _ -> Just $ SearchPackages rest

src/web/FloraWeb/Pages/Server/Packages.hs

@@ -77,7 +77,7 @@ showNamespaceHandler namespace pageParam = do
   let pageNumber = pageParam ?: PositiveUnsafe 1
   session <- getSession
   templateDefaults <- fromSession session defaultTemplateEnv
-  (count', results) <- Search.listAllPackagesInNamespace namespace (fromPage pageNumber)
+  (count', results) <- Search.listAllPackagesInNamespace (fromPage pageNumber) namespace
   if extractNamespaceText namespace == "haskell"
     then
       render templateDefaults $

src/web/FloraWeb/Pages/Server/Search.hs

@@ -4,14 +4,13 @@ import Data.Positive
 import Data.Text (Text)
 import Data.Vector qualified as Vector
 import Lucid (Html)
-import Optics.Core
 import Servant (ServerT)
 
 import Flora.Model.Package.Types
 import Flora.Search qualified as Search
 import FloraWeb.Common.Pagination
 import FloraWeb.Pages.Routes.Search (Routes, Routes' (..))
-import FloraWeb.Pages.Templates (TemplateEnv (..), defaultTemplateEnv, fromSession, render)
+import FloraWeb.Pages.Templates (defaultTemplateEnv, fromSession, render)
 import FloraWeb.Pages.Templates.Screens.Search qualified as Search
 import FloraWeb.Session
 
@@ -23,18 +22,10 @@ server =
 
 searchHandler :: Maybe Text -> Maybe (Positive Word) -> FloraPage (Html ())
 searchHandler Nothing pageParam = searchHandler (Just "") pageParam
-searchHandler (Just "") pageParam = do
-  let pageNumber = pageParam ?: PositiveUnsafe 1
-  session <- getSession
-  templateDefaults <- fromSession session defaultTemplateEnv
-  (count, results) <- Search.listAllPackages (fromPage pageNumber)
-  let (templateEnv :: TemplateEnv) =
-        templateDefaults & #displayNavbarSearch .~ False
-  render templateEnv $ Search.showAllPackages count pageNumber results
 searchHandler (Just searchString) pageParam = do
   let pageNumber = pageParam ?: PositiveUnsafe 1
   session <- getSession
   templateEnv <- fromSession session defaultTemplateEnv
-  (count, results) <- Search.searchPackageByName (fromPage pageNumber) searchString
+  (count, results) <- Search.search (fromPage pageNumber) searchString
   let (matchVector, packagesInfo) = Vector.partition (\p -> p.name == PackageName searchString) results
   render templateEnv $ Search.showResults searchString count pageNumber matchVector packagesInfo

src/web/FloraWeb/Pages/Templates/Packages.hs

@@ -66,7 +66,7 @@ presentationHeaderForSubpage namespace packageName release target numberOfPackag
     span_ [class_ "headline"] $ do
       displayNamespace namespace
       chevronRightOutline
-      linkToPackageWithVersion namespace packageName (release.version)
+      linkToPackageWithVersion namespace packageName release.version
       chevronRightOutline
       toHtml (display target)
   p_ [class_ "synopsis"] $

test/Flora/PackageSpec.hs

@@ -228,9 +228,9 @@ testReleaseDeprecation = do
   assertEqual 68 (length result)
 
   binary <- fromJust <$> Query.getPackageByNamespaceAndName (Namespace "haskell") (PackageName "binary")
-  deprecatedBinaryVersion' <- assertJust =<< Query.getReleaseByVersion (binary.packageId) (mkVersion [0, 10, 0, 0])
+  deprecatedBinaryVersion' <- assertJust =<< Query.getReleaseByVersion binary.packageId (mkVersion [0, 10, 0, 0])
   Update.setReleasesDeprecationMarker (Vector.singleton (True, deprecatedBinaryVersion'.releaseId))
-  deprecatedBinaryVersion <- assertJust =<< Query.getReleaseByVersion (binary.packageId) (mkVersion [0, 10, 0, 0])
+  deprecatedBinaryVersion <- assertJust =<< Query.getReleaseByVersion binary.packageId (mkVersion [0, 10, 0, 0])
   assertEqual deprecatedBinaryVersion.deprecated (Just True)
 
 ---