From f07200b2565a5d91d1b9b4f0ebd018179c0a8349 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Th=C3=A9ophile=20Choutri?= Date: Wed, 29 Jun 2022 00:57:11 +0200 Subject: [PATCH] Add search test (#149) * Add a test for search * lint --- CONTRIBUTING.md | 13 +- src/Flora/Search.hs | 11 +- src/FloraWeb/Server/Pages/Search.hs | 9 +- test/Flora/PackageSpec.hs | 15 ++ test/fixtures/Cabal/text-1.2.5.0.cabal | 267 +++++++++++++++++++++++ test/fixtures/Cabal/text-2.0.cabal | 287 +++++++++++++++++++++++++ 6 files changed, 585 insertions(+), 17 deletions(-) create mode 100644 test/fixtures/Cabal/text-1.2.5.0.cabal create mode 100644 test/fixtures/Cabal/text-2.0.cabal diff --git a/CONTRIBUTING.md b/CONTRIBUTING.md index aae45c22..5988d215 100644 --- a/CONTRIBUTING.md +++ b/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 diff --git a/src/Flora/Search.hs b/src/Flora/Search.hs index aab7c7fe..1beb630f 100644 --- a/src/Flora/Search.hs +++ b/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 diff --git a/src/FloraWeb/Server/Pages/Search.hs b/src/FloraWeb/Server/Pages/Search.hs index 364594da..dd2ddf44 100644 --- a/src/FloraWeb/Server/Pages/Search.hs +++ b/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 diff --git a/test/Flora/PackageSpec.hs b/test/Flora/PackageSpec.hs index ed59497d..36288336 100644 --- a/test/Flora/PackageSpec.hs +++ b/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 diff --git a/test/fixtures/Cabal/text-1.2.5.0.cabal b/test/fixtures/Cabal/text-1.2.5.0.cabal new file mode 100644 index 00000000..b0a52da5 --- /dev/null +++ b/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 and + . + + +license: BSD2 +license-file: LICENSE +author: Bryan O'Sullivan +maintainer: Haskell Text Team , 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 diff --git a/test/fixtures/Cabal/text-2.0.cabal b/test/fixtures/Cabal/text-2.0.cabal new file mode 100644 index 00000000..731b8f81 --- /dev/null +++ b/test/fixtures/Cabal/text-2.0.cabal @@ -0,0 +1,287 @@ +cabal-version: 2.2 +name: text +version: 2.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). + . + 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/). + +license: BSD-2-Clause +license-file: LICENSE +author: Bryan O'Sullivan +maintainer: Haskell Text Team , Core Libraries Committee +copyright: 2009-2011 Bryan O'Sullivan, 2008-2009 Tom Harper, 2021 Andrew Lelechenko +category: Data, Text +build-type: Simple +tested-with: + GHC == 8.0.2 + GHC == 8.2.2 + GHC == 8.4.4 + GHC == 8.6.5 + GHC == 8.8.4 + GHC == 8.10.7 + GHC == 9.0.1 + GHC == 9.2.1 + +extra-source-files: + -- scripts/CaseFolding.txt + -- scripts/SpecialCasing.txt + README.markdown + changelog.md + scripts/*.hs + simdutf/LICENSE-APACHE + simdutf/LICENSE-MIT + simdutf/simdutf.h + tests/literal-rule-test.sh + tests/LiteralRuleTest.hs + +flag developer + description: operate in developer mode + default: False + manual: True + +flag simdutf + description: use simdutf library + default: True + manual: True + +library + c-sources: cbits/is_ascii.c + cbits/measure_off.c + cbits/reverse.c + cbits/utils.c + hs-source-dirs: src + + if flag(simdutf) + include-dirs: simdutf + cxx-sources: simdutf/simdutf.cpp + cbits/validate_utf8.cpp + cxx-options: -std=c++17 + cpp-options: -DSIMDUTF + if os(windows) + if arch(x86_64) + extra-libraries: stdc++-6 gcc_s_seh-1 + else + extra-libraries: stdc++-6 gcc_s_dw2-1 + else + if os(darwin) + extra-libraries: c++ + else + extra-libraries: stdc++ + + 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.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.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 + + -- https://gitlab.haskell.org/ghc/ghc/-/issues/19900 + if os(windows) + extra-libraries: gcc_s + + 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.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.12.6 && < 2.15, + base <5, + bytestring, + deepseq, + directory, + ghc-prim, + tasty, + tasty-hunit, + tasty-quickcheck, + template-haskell, + text + + -- Starting from 9.2 ghc library depends on parsec, + -- which causes circular dependency. + if impl(ghc < 9.2) + build-depends: tasty-inspection-testing + + 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, + bytestring >= 0.10.4, + containers, + deepseq, + directory, + filepath, + tasty-bench >= 0.2, + text, + transformers + + 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.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