Resume the work on V1 Search engine

Makefile

@@ -42,13 +42,13 @@ ghci: repl ## Start a cabal REPL (alias for `make repl`)
 watch: soufflé ## Load the main library and reload on file change
 	@ghcid --target flora-server -l
 
-test: ## Run the test suite
+test: soufflé ## Run the test suite
 	./scripts/run-tests.sh
 
-watch-test: ## Load the tests in ghcid and reload them on file change
+watch-test: soufflé ## Load the tests in ghcid and reload them on file change
 	./scripts/run-tests.sh --watch
 
-watch-server: ## Start flora-server in ghcid
+watch-server: soufflé ## Start flora-server in ghcid
 	@ghcid --target=flora-server --restart="src" --test 'FloraWeb.Server.runFlora'
 
 lint: ## Run the code linter (HLint)

app/cli/Main.hs

@@ -56,9 +56,9 @@ runOptions (Options Provision) = do
 
     void importCategories
 
-    void $ importPackage (hackageUser ^. #userId) (Namespace "haskell") (PackageName "bytestring") "./test/fixtures/Cabal/"
-    void $ importPackage (hackageUser ^. #userId) (Namespace "haskell") (PackageName "parsec") "./test/fixtures/Cabal/"
-    void $ importPackage (hackageUser ^. #userId) (Namespace "haskell") (PackageName "Cabal") "./test/fixtures/Cabal/"
+    void $ importPackage (hackageUser ^. #userId) (PackageName "bytestring") "./test/fixtures/Cabal/"
+    void $ importPackage (hackageUser ^. #userId) (PackageName "parsec") "./test/fixtures/Cabal/"
+    void $ importPackage (hackageUser ^. #userId) (PackageName "Cabal") "./test/fixtures/Cabal/"
 
 
 runOptions (Options (CoverageReport opts)) = runCoverageReport opts

src/Flora/Model/Package/Query.hs

@@ -16,7 +16,7 @@ import Database.PostgreSQL.Simple.SqlQQ (sql)
 import Database.PostgreSQL.Transact (DBT)
 import Flora.Model.Category (Category)
 import Flora.Model.Category.Types (PackageCategory)
-import Flora.Model.Package (Namespace, Package, PackageId, PackageName)
+import Flora.Model.Package (Namespace (Namespace), Package, PackageId, PackageName)
 import Flora.Model.Package.Component (ComponentId, ComponentType,
                                       PackageComponent)
 import Flora.Model.Release (ReleaseId)
@@ -110,11 +110,12 @@ getPackageCategories :: MonadIO m
 getPackageCategories packageId = joinSelectOneByField @Category @PackageCategory [field| category_id |] [field| package_id |] packageId
 
 
-searchPackage :: Text -> DBT IO (Vector (Namespace, PackageName, Float))
+searchPackage :: Text -> DBT IO (Vector (Namespace, PackageName, Text, Float))
 searchPackage searchString = query Select [sql|
   SELECT  p."namespace"
-       , p."name"
-       , word_similarity(p.name, ?) as rating
+        , p."name"
+        , p."synopsis"
+        , word_similarity(p.name, ?) as rating
   FROM packages as p
   WHERE ? <% p.name
   GROUP BY
@@ -123,3 +124,18 @@ searchPackage searchString = query Select [sql|
   ORDER BY rating desc, count(p."namespace") desc, p.name asc;
 
   |] (searchString, searchString)
+
+searchPackageByNamespace :: Namespace -> Text -> DBT IO (Vector (Namespace, PackageName, Text, Float))
+searchPackageByNamespace (Namespace namespace) searchString = query Select [sql|
+  SELECT  p."namespace"
+        , p."name"
+        , p."synopsis"
+        , word_similarity(p.name, ?) as rating
+  FROM packages as p
+  WHERE ? <% p.name
+    AND p."namespace" = ?
+  GROUP BY
+      p."namespace"
+    , p."name"
+  ORDER BY rating desc, count(p."namespace") desc, p.name asc;
+  |] (searchString, searchString, namespace)

src/Flora/Search.hs

@@ -1,6 +1,25 @@
 module Flora.Search where
 
 import Data.Text
+import Data.Vector (Vector)
 
-query :: Text -> m [Text]
-query _searchString = undefined
+import FloraWeb.Server.Auth (FloraPageM)
+import Flora.Model.Package (Namespace(..), PackageName)
+import Flora.Environment (FloraEnv(..))
+import qualified Flora.Model.Package.Query as Query
+import Control.Monad.IO.Class
+import Database.PostgreSQL.Entity.DBT (withPool)
+import FloraWeb.Session (getSession, Session(..))
+import FloraWeb.Types (fetchFloraEnv)
+import Optics.Core
+
+-- searchPackageByNamespace :: Namespace -> Text -> FloraPageM (Vector Package)
+-- searchPackageByNamespace (Namespace namespace) query = undefined
+
+searchPackageByName :: Text -> FloraPageM (Vector (Namespace, PackageName, Text))
+searchPackageByName queryString = do
+  session <- getSession
+  FloraEnv{pool} <- liftIO $ fetchFloraEnv (session ^. #webEnvStore)
+  results <- liftIO $ withPool pool $ Query.searchPackage queryString
+  let getInfo = (,,) <$> view _1 <*> view _2 <*> view _3
+  pure $ fmap getInfo results

src/FloraWeb/Session.hs

@@ -1,11 +1,19 @@
-module FloraWeb.Session where
+module FloraWeb.Session
+  ( module FloraWeb.Server.Auth.Types 
+  , getSession
+  , craftSessionCookie
+  , emptySessionCookie
+  , addCookie
+  , deleteCookie
+  ) where
 
 import Control.Monad.Reader
 import Data.Kind
 import qualified Data.UUID as UUID
 import Servant (Header, Headers, addHeader, getResponse)
 import Web.Cookie
 
+
 import Flora.Model.PersistentSession
 import FloraWeb.Server.Auth.Types
 

test/Flora/PackageSpec.hs

@@ -89,7 +89,8 @@ testSearchingForBase :: TestM ()
 testSearchingForBase = do
   liftDB $ importCabal (hackageUser ^. #userId) (PackageName "base") "./test/fixtures/Cabal/"
   result <- liftDB $ Query.searchPackage "base"
-  assertEqual (Vector.fromList [(Namespace "haskell", PackageName "base", 1)]) result
+  assertEqual (Vector.fromList [(PackageName "base", 1)])
+              (result & (,) <$> view _2 <*> view _4)
 
 testPackageSearchResultOrdering :: TestM ()
 testPackageSearchResultOrdering = undefined