Add search test (#149)

* Add a test for search

* lint

CONTRIBUTING.md

@@ -7,14 +7,15 @@ We need you to read and acknowledge our [Code of Conduct][CoC] document.
 
 The following Haskell command-line tools will have to be installed:
 
-* `postgresql-migration`: The tool used to perform schema migrations
-* `fourmolu`: The tool to style the code base
-* `hlint` & `apply-refact`: The tools to enforce certain patterns in the code base ("lint")
-* `cabal-fmt` and `nixfmt`: the tools to style the cabal and nix files
-* `ghcid`: The tool to automatically reload the Haskell code base upon source changes
+* `postgresql-migration`: To perform schema migrations
+* `fourmolu`: To style the code base
+* `hlint` & `apply-refact`: To enforce certain patterns in the code base ("lint")
+* `cabal-fmt` and `nixfmt`: To style the cabal and nix files
+* `ghcid`: To automatically reload the Haskell code base upon source changes
+* `ghc-tags`: To generate ctags or etags for the project
 
 ```bash
-$ cabal install -j postgresql-migration fourmolu hlint apply-refact cabal-fmt nixfmt ghcid
+$ cabal install -j postgresql-migration fourmolu hlint apply-refact cabal-fmt nixfmt ghcid ghc-tags
 ```
 
 * `yarn`: The tool that handles the JavaScript code bases

src/Flora/Search.hs

@@ -4,6 +4,7 @@ import Data.Text (Text)
 import Data.Vector (Vector)
 
 import Control.Monad.IO.Class
+import Data.Aeson
 import Data.Text.Display (Display (..))
 import qualified Data.Text.Lazy.Builder as Builder
 import Database.PostgreSQL.Entity.DBT (withPool)
@@ -14,6 +15,7 @@ import qualified Flora.Model.Package.Query as Query
 import FloraWeb.Server.Auth (FloraPageM)
 import FloraWeb.Session (Session (..), getSession)
 import FloraWeb.Types (fetchFloraEnv)
+import qualified Log
 import Optics.Core
 
 data SearchAction
@@ -25,13 +27,16 @@ instance Display SearchAction where
   displayBuilder ListAllPackages = "Packages"
   displayBuilder (SearchPackages title) = "\"" <> Builder.fromText title <> "\""
 
-searchPackageByName :: Word -> Text -> FloraPageM (Vector (Namespace, PackageName, Text, Version))
+searchPackageByName :: Word -> Text -> FloraPageM (Word, Vector (Namespace, PackageName, Text, Version))
 searchPackageByName pageNumber queryString = do
   session <- getSession
   FloraEnv{pool} <- liftIO $ fetchFloraEnv (session ^. #webEnvStore)
-  results <- liftIO $ withPool pool $ Query.searchPackage pageNumber queryString
+  dbResults <- liftIO $ withPool pool $ Query.searchPackage pageNumber queryString
   let getInfo = (,,,) <$> view _1 <*> view _2 <*> view _3 <*> view _4
-  pure $ fmap getInfo results
+  count <- liftIO $ withPool pool $ Query.countPackagesByName queryString
+  let results = fmap getInfo dbResults
+  Log.logInfo "search" $ object ["query_string" .= queryString, "results_count" .= count]
+  pure (count, results)
 
 listAllPackages :: Word -> FloraPageM (Word, Vector (Namespace, PackageName, Text, Version))
 listAllPackages pageNumber = do

src/FloraWeb/Server/Pages/Search.hs

@@ -1,17 +1,12 @@
 module FloraWeb.Server.Pages.Search where
 
-import Control.Monad.IO.Class (liftIO)
 import Data.Maybe (fromMaybe)
 import Data.Text (Text)
-import Database.PostgreSQL.Entity.DBT (withPool)
-import Flora.Environment (FloraEnv (..))
-import qualified Flora.Model.Package.Query as Query
 import qualified Flora.Search as Search
 import FloraWeb.Routes.Pages.Search (Routes, Routes' (..))
 import FloraWeb.Session
 import FloraWeb.Templates (TemplateEnv (..), defaultTemplateEnv, fromSession, render)
 import qualified FloraWeb.Templates.Pages.Search as Search
-import FloraWeb.Types (fetchFloraEnv)
 import Lucid (Html)
 import Optics.Core
 import Servant (ServerT)
@@ -36,8 +31,6 @@ searchHandler (Just "") pageParam = do
 searchHandler (Just searchString) pageParam = do
   let pageNumber = fromMaybe 0 pageParam
   session <- getSession
-  FloraEnv{pool} <- liftIO $ fetchFloraEnv (session ^. #webEnvStore)
   templateEnv <- fromSession session defaultTemplateEnv
-  results <- Search.searchPackageByName pageNumber searchString
-  count <- liftIO $ withPool pool $ Query.countPackagesByName searchString
+  (count, results) <- Search.searchPackageByName pageNumber searchString
   render templateEnv $ Search.showResults searchString count pageNumber results

test/Flora/PackageSpec.hs

@@ -8,9 +8,11 @@ import qualified Data.Vector as Vector
 import Optics.Core
 import Test.Tasty
 
+import Control.Monad.IO.Class
 import Data.Foldable
 import Data.Function
 import qualified Data.Vector as V
+import qualified Distribution.Types.Version as Cabal
 import Flora.Environment (TestEnv (TestEnv))
 import Flora.Import.Package
 import Flora.Import.Package.Bulk (importAllFilesInRelativeDirectory)
@@ -33,6 +35,7 @@ spec fixtures =
     , testThis "@hackage/semigroups belongs to appropriate categories" $ testThatSemigroupsIsInMathematicsAndDataStructures fixtures
     , testThis "The \"haskell\" namespace has the correct number of packages" $ testCorrectNumberInHaskellNamespace fixtures
     , testThis "@haskell/bytestring has the correct number of dependents" $ testBytestringDependents fixtures
+    , testThis "Searching for `text` returns unique results by namespace/package name" $ testSearchResultUnicity fixtures
     ]
 
 testInsertBase :: Fixtures -> TestM ()
@@ -112,6 +115,18 @@ testBytestringDependencies = do
   latestReleasedependencies <- liftDB $ Query.getRequirements (latestRelease ^. #releaseId)
   assertEqual 4 (Vector.length latestReleasedependencies)
 
+testSearchResultUnicity :: Fixtures -> TestM ()
+testSearchResultUnicity fixtures = do
+  importAllPackages fixtures
+  text <- liftDB $ fromJust <$> Query.getPackageByNamespaceAndName (Namespace "haskell") (PackageName "text")
+  releases <- liftDB $ Query.getNumberOfReleases (text ^. #packageId)
+  assertEqual 2 releases
+  results <- liftDB $ Query.searchPackage 0 "text"
+  assertEqual 1 (Vector.length results)
+  assertEqual (Cabal.mkVersion [2, 0]) (view _4 $ Vector.head results)
+
+----------------------------
+
 importAllPackages :: Fixtures -> TestM ()
 importAllPackages fixtures = do
   TestEnv _ pool <- getTestEnv

test/fixtures/Cabal/text-1.2.5.0.cabal

@@ -0,0 +1,267 @@
+cabal-version:  >= 1.10
+name:           text
+version:        1.2.5.0
+
+homepage:       https://github.com/haskell/text
+bug-reports:    https://github.com/haskell/text/issues
+synopsis:       An efficient packed Unicode text type.
+description:
+    .
+    An efficient packed, immutable Unicode text type (both strict and
+    lazy), with a powerful loop fusion optimization framework.
+    .
+    The 'Text' type represents Unicode character strings, in a time and
+    space-efficient manner. This package provides text processing
+    capabilities that are optimized for performance critical use, both
+    in terms of large data quantities and high speed.
+    .
+    The 'Text' type provides character-encoding, type-safe case
+    conversion via whole-string case conversion functions (see "Data.Text").
+    It also provides a range of functions for converting 'Text' values to
+    and from 'ByteStrings', using several standard encodings
+    (see "Data.Text.Encoding").
+    .
+    Efficient locale-sensitive support for text IO is also supported
+    (see "Data.Text.IO").
+    .
+    These modules are intended to be imported qualified, to avoid name
+    clashes with Prelude functions, e.g.
+    .
+    > import qualified Data.Text as T
+    .
+    == ICU Support
+    .
+    To use an extended and very rich family of functions for working
+    with Unicode text (including normalization, regular expressions,
+    non-standard encodings, text breaking, and locales), see
+    the [text-icu package](https://hackage.haskell.org/package/text-icu)
+    based on the well-respected and liberally
+    licensed [ICU library](http://site.icu-project.org/).
+    .
+    == Internal Representation: UTF-16 vs. UTF-8
+    .
+    Currently the @text@ library uses UTF-16 as its internal representation
+    which is [neither a fixed-width nor always the most dense representation](http://utf8everywhere.org/)
+    for Unicode text. We're currently investigating the feasibility
+    of [changing Text's internal representation to UTF-8](https://github.com/text-utf8)
+    and if you need such a 'Text' type right now you might be interested in using the spin-off
+    packages <https://hackage.haskell.org/package/text-utf8 text-utf8> and
+    <https://hackage.haskell.org/package/text-short text-short>.
+
+
+license:        BSD2
+license-file:   LICENSE
+author:         Bryan O'Sullivan <[email protected]>
+maintainer:     Haskell Text Team <[email protected]>, Core Libraries Committee
+copyright:      2009-2011 Bryan O'Sullivan, 2008-2009 Tom Harper
+category:       Data, Text
+build-type:     Simple
+tested-with:    GHC==9.0.1,
+                GHC==8.10.4, GHC==8.8.4, GHC==8.6.5, GHC==8.4.4,
+                GHC==8.2.2, GHC==8.0.2
+extra-source-files:
+    -- scripts/CaseFolding.txt
+    -- scripts/SpecialCasing.txt
+    README.markdown
+    changelog.md
+    include/*.h
+    scripts/*.hs
+    tests/literal-rule-test.sh
+    tests/LiteralRuleTest.hs
+
+flag developer
+  description: operate in developer mode
+  default: False
+  manual: True
+
+library
+  c-sources:    cbits/cbits.c
+  include-dirs: include
+  hs-source-dirs: src
+
+  exposed-modules:
+    Data.Text
+    Data.Text.Array
+    Data.Text.Encoding
+    Data.Text.Encoding.Error
+    Data.Text.Foreign
+    Data.Text.IO
+    Data.Text.Internal
+    Data.Text.Internal.Builder
+    Data.Text.Internal.Builder.Functions
+    Data.Text.Internal.Builder.Int.Digits
+    Data.Text.Internal.Builder.RealFloat.Functions
+    Data.Text.Internal.ByteStringCompat
+    Data.Text.Internal.PrimCompat
+    Data.Text.Internal.Encoding.Fusion
+    Data.Text.Internal.Encoding.Fusion.Common
+    Data.Text.Internal.Encoding.Utf16
+    Data.Text.Internal.Encoding.Utf32
+    Data.Text.Internal.Encoding.Utf8
+    Data.Text.Internal.Functions
+    Data.Text.Internal.Fusion
+    Data.Text.Internal.Fusion.CaseMapping
+    Data.Text.Internal.Fusion.Common
+    Data.Text.Internal.Fusion.Size
+    Data.Text.Internal.Fusion.Types
+    Data.Text.Internal.IO
+    Data.Text.Internal.Lazy
+    Data.Text.Internal.Lazy.Encoding.Fusion
+    Data.Text.Internal.Lazy.Fusion
+    Data.Text.Internal.Lazy.Search
+    Data.Text.Internal.Private
+    Data.Text.Internal.Read
+    Data.Text.Internal.Search
+    Data.Text.Internal.Unsafe
+    Data.Text.Internal.Unsafe.Char
+    Data.Text.Internal.Unsafe.Shift
+    Data.Text.Lazy
+    Data.Text.Lazy.Builder
+    Data.Text.Lazy.Builder.Int
+    Data.Text.Lazy.Builder.RealFloat
+    Data.Text.Lazy.Encoding
+    Data.Text.Lazy.IO
+    Data.Text.Lazy.Internal
+    Data.Text.Lazy.Read
+    Data.Text.Read
+    Data.Text.Unsafe
+
+  other-modules:
+    Data.Text.Show
+
+  build-depends:
+    array            >= 0.3 && < 0.6,
+    base             >= 4.9 && < 5,
+    binary           >= 0.5 && < 0.9,
+    bytestring       >= 0.10.4 && < 0.12,
+    deepseq          >= 1.1 && < 1.5,
+    ghc-prim         >= 0.2 && < 0.9,
+    template-haskell >= 2.5 && < 2.19
+
+  ghc-options: -Wall -fwarn-tabs -funbox-strict-fields -O2
+  if flag(developer)
+    ghc-options: -fno-ignore-asserts
+    cpp-options: -DASSERTS
+
+  default-language: Haskell2010
+  default-extensions:
+    NondecreasingIndentation
+  other-extensions:
+    BangPatterns
+    CPP
+    DeriveDataTypeable
+    ExistentialQuantification
+    ForeignFunctionInterface
+    GeneralizedNewtypeDeriving
+    MagicHash
+    OverloadedStrings
+    Rank2Types
+    RankNTypes
+    RecordWildCards
+    Safe
+    ScopedTypeVariables
+    TemplateHaskellQuotes
+    Trustworthy
+    TypeFamilies
+    UnboxedTuples
+    UnliftedFFITypes
+
+source-repository head
+  type:     git
+  location: https://github.com/haskell/text
+
+test-suite tests
+  type:           exitcode-stdio-1.0
+  ghc-options:
+    -Wall -threaded -rtsopts
+
+  hs-source-dirs: tests
+  main-is:        Tests.hs
+  other-modules:
+    Tests.Inspection.Lazy
+    Tests.Inspection.Strict
+    Tests.Lift
+    Tests.Properties
+    Tests.Properties.Basics
+    Tests.Properties.Builder
+    Tests.Properties.Folds
+    Tests.Properties.Instances
+    Tests.Properties.LowLevel
+    Tests.Properties.Read
+    Tests.Properties.Substrings
+    Tests.Properties.Text
+    Tests.Properties.Transcoding
+    Tests.QuickCheckUtils
+    Tests.Regressions
+    Tests.SlowFunctions
+    Tests.Utils
+
+  build-depends:
+    QuickCheck >= 2.14.1 && < 2.15,
+    base <5,
+    bytestring,
+    deepseq,
+    directory,
+    quickcheck-unicode >= 1.0.1.0,
+    random,
+    tasty,
+    tasty-hunit,
+    tasty-inspection-testing,
+    tasty-quickcheck,
+    template-haskell,
+    text
+
+  default-language: Haskell2010
+  default-extensions: NondecreasingIndentation
+
+benchmark text-benchmarks
+  type:           exitcode-stdio-1.0
+
+  ghc-options:    -Wall -O2 -rtsopts
+  if impl(ghc >= 8.10)
+    ghc-options:  "-with-rtsopts=-A32m --nonmoving-gc"
+  else
+    ghc-options:  "-with-rtsopts=-A32m"
+
+  build-depends:  base,
+                  binary,
+                  bytestring >= 0.10.4,
+                  bytestring-lexing >= 0.5.0,
+                  containers,
+                  deepseq,
+                  filepath,
+                  stringsearch,
+                  tasty-bench >= 0.2,
+                  text,
+                  transformers,
+                  vector
+
+  c-sources:      benchmarks/cbits-bench/time_iconv.c
+  hs-source-dirs: benchmarks/haskell
+  main-is:        Benchmarks.hs
+  other-modules:
+    Benchmarks.Builder
+    Benchmarks.Concat
+    Benchmarks.DecodeUtf8
+    Benchmarks.EncodeUtf8
+    Benchmarks.Equality
+    Benchmarks.FileRead
+    Benchmarks.FoldLines
+    Benchmarks.Mul
+    Benchmarks.Multilang
+    Benchmarks.Programs.BigTable
+    Benchmarks.Programs.Cut
+    Benchmarks.Programs.Fold
+    Benchmarks.Programs.Sort
+    Benchmarks.Programs.StripTags
+    Benchmarks.Programs.Throughput
+    Benchmarks.Pure
+    Benchmarks.ReadNumbers
+    Benchmarks.Replace
+    Benchmarks.Search
+    Benchmarks.Stream
+    Benchmarks.WordFrequencies
+
+  default-language: Haskell2010
+  default-extensions: NondecreasingIndentation
+  other-extensions: DeriveGeneric