Support improved document search

This commit also uses a temporary fork of boolexpr.
It allows to parse certain terms like "Niki" without choking.

bin/update-cabal-project

@@ -11,8 +11,8 @@ STORE_DIR="${1:-$DEFAULT_STORE}"
 # `expected_cabal_project_freeze_hash` with the
 # `sha256sum` result calculated on the `cabal.project` and `cabal.project.freeze`.
 # This ensures the files stay deterministic so that CI cache can kick in.
-expected_cabal_project_hash="7b82fda55b0051a14b461ce3939e934da47e417794de69cb70973702c43e337e"
-expected_cabal_project_freeze_hash="b7acfd12c970323ffe2c6684a13130db09d8ec9fa5676a976afed329f1ef3436"
+expected_cabal_project_hash="297d2ac44b8a2e65a9d7bbbe1fb6e5e0ff46b144300501c14e5e424e77aa1abf"
+expected_cabal_project_freeze_hash="2d3704d107bd8d08056ce4f0eb1f42202cb7f49a67c62a2445a6c70c7235f861"
 
 cabal --store-dir=$STORE_DIR v2-update 'hackage.haskell.org,2023-06-24T21:28:46Z'
 

cabal.project

@@ -7,6 +7,11 @@ with-compiler: ghc-8.10.7
 packages:
     ./
 
+source-repository-package
+    type: git
+    location: https://github.com/adinapoli/boolexpr.git
+    tag: 91928b5d7f9342e9865dde0d94862792d2b88779
+
 source-repository-package
     type: git
     location: https://github.com/adinapoli/haskell-opaleye.git

cabal.project.freeze

@@ -384,7 +384,6 @@ constraints: any.AC-Angle ==1.0,
              any.bodhi ==0.1.0,
              any.boltzmann-samplers ==0.1.1.0,
              any.boolean-like ==0.1.1.0,
-             any.boolexpr ==0.2,
              any.boolsimplifier ==0.1.8,
              any.boots ==0.2.0.1,
              any.bordacount ==0.1.0.0,

src/Gargantext/API/Table.hs

@@ -44,7 +44,7 @@ import Test.QuickCheck.Arbitrary (Arbitrary, arbitrary)
 import Gargantext.API.HashedResponse
 import Gargantext.API.Ngrams.Types (TabType(..))
 import Gargantext.API.Prelude (GargServer)
-import Gargantext.Core.Text.Corpus.Query (RawQuery, parseQuery)
+import Gargantext.Core.Text.Corpus.Query (RawQuery, parseQuery, getRawQuery)
 import Gargantext.Core.Types (TableResult(..))
 import Gargantext.Core.Types.Query (Offset, Limit)
 import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger)
@@ -55,6 +55,8 @@ import Gargantext.Database.Prelude -- (Cmd, CmdM)
 import Gargantext.Database.Query.Facet (FacetDoc , runViewDocuments, runCountDocuments, OrderBy(..), runViewAuthorsDoc)
 import Gargantext.Database.Query.Table.Node.Error (HasNodeError)
 import Gargantext.Prelude
+import Gargantext.System.Logging
+import qualified Data.Text as T
 
 ------------------------------------------------------------------------
 
@@ -63,7 +65,7 @@ type TableApi = Summary "Table API"
               :> QueryParam "limit" Limit
               :> QueryParam "offset" Offset
               :> QueryParam "orderBy" OrderBy
-              :> QueryParam "query" Text
+              :> QueryParam "query" RawQuery
               :> QueryParam "year" Text
               :> Get    '[JSON] (HashedResponse FacetTableResult)
             :<|> Summary "Table API (POST)"
@@ -103,47 +105,67 @@ tableApi id' = getTableApi id'
           :<|> getTableHashApi id'
 
 
-getTableApi :: HasNodeError err
+getTableApi :: (CmdM env err m, HasNodeError err, MonadLogger m)
             => NodeId
             -> Maybe TabType
             -> Maybe Limit
             -> Maybe Offset
             -> Maybe OrderBy
+            -> Maybe RawQuery
             -> Maybe Text
-            -> Maybe Text
-            -> Cmd err (HashedResponse FacetTableResult)
-getTableApi cId tabType mLimit mOffset mOrderBy mQuery mYear = do
-  -- printDebug "[getTableApi] mQuery" mQuery
-  -- printDebug "[getTableApi] mYear" mYear
-  t <- getTable cId tabType mOffset mLimit mOrderBy mQuery mYear
-  pure $ constructHashedResponse t
-
-postTableApi :: HasNodeError err => NodeId -> TableQuery -> Cmd err FacetTableResult
+            -> m (HashedResponse FacetTableResult)
+getTableApi cId tabType mLimit mOffset mOrderBy mQuery mYear =
+  case mQuery of
+    Nothing -> get_table
+    Just "" -> get_table
+    Just q  -> case tabType of
+      Just Docs
+        -> do
+          $(logLocM) DEBUG $ "New search with query " <> getRawQuery q
+          constructHashedResponse <$> searchInCorpus' cId False q mOffset mLimit mOrderBy
+      Just Trash
+        -> constructHashedResponse <$> searchInCorpus' cId True q mOffset mLimit mOrderBy
+      _ -> get_table
+
+  where
+    get_table = do
+      $(logLocM) DEBUG $ "getTable cId = " <> T.pack (show cId)
+      t <- getTable cId tabType mOffset mLimit mOrderBy mQuery mYear
+      pure $ constructHashedResponse t
+
+postTableApi :: (CmdM env err m, MonadLogger m, HasNodeError err) => NodeId -> TableQuery -> m FacetTableResult
 postTableApi cId tq = case tq of
- TableQuery o l order ft "" -> getTable cId (Just ft) (Just o) (Just l) (Just order) Nothing Nothing
+ TableQuery o l order ft "" -> do
+   $(logLocM) DEBUG $ "New search with no query"
+   getTable cId (Just ft) (Just o) (Just l) (Just order) Nothing Nothing
  TableQuery o l order ft q  -> case ft of
-   Docs  -> searchInCorpus' cId False q (Just o) (Just l) (Just order)
+   Docs  -> do
+     $(logLocM) DEBUG $ "New search with query " <> getRawQuery q
+     searchInCorpus' cId False q (Just o) (Just l) (Just order)
    Trash -> searchInCorpus' cId True  q (Just o) (Just l) (Just order)
    x     -> panic $ "not implemented in tableApi " <> (cs $ show x)
 
-getTableHashApi :: HasNodeError err
-                => NodeId -> Maybe TabType -> Cmd err Text
+getTableHashApi :: (CmdM env err m, HasNodeError err, MonadLogger m)
+                => NodeId
+                -> Maybe TabType
+                -> m Text
 getTableHashApi cId tabType = do
   HashedResponse { hash = h } <- getTableApi cId tabType Nothing Nothing Nothing Nothing Nothing
   pure h
 
-searchInCorpus' :: CorpusId
+searchInCorpus' :: (CmdM env err m, MonadLogger m)
+                => CorpusId
                 -> Bool
                 -> RawQuery
                 -> Maybe Offset
                 -> Maybe Limit
                 -> Maybe OrderBy
-                -> Cmd err FacetTableResult
+                -> m FacetTableResult
 searchInCorpus' cId t q o l order = do
   case parseQuery q of
     -- FIXME(adn) The error handling needs to be monomorphic over GargErr.
-    Left _noParseErr -> do
-      -- - $(logLocM) ERROR $ "Invalid input query " <> (getRawQuery q) <> " , error = " <> (T.pack noParseErr)
+    Left noParseErr -> do
+      $(logLocM) ERROR $ "Invalid input query " <> (getRawQuery q) <> " , error = " <> (T.pack noParseErr)
       pure $ TableResult 0 []
     Right boolQuery -> do
       docs          <- searchInCorpus cId t boolQuery o l order
@@ -157,13 +179,15 @@ getTable :: HasNodeError err
          -> Maybe Offset
          -> Maybe Limit
          -> Maybe OrderBy
-         -> Maybe Text
+         -> Maybe RawQuery
          -> Maybe Text
          -> Cmd err FacetTableResult
-getTable cId ft o l order query year = do
+getTable cId ft o l order raw_query year = do
   docs      <- getTable' cId ft o l order query year
   docsCount <- runCountDocuments cId (ft == Just Trash) query year
   pure $ TableResult { tr_docs = docs, tr_count = docsCount }
+  where
+    query = getRawQuery <$> raw_query
 
 getTable' :: HasNodeError err
           => NodeId

stack.yaml

@@ -98,12 +98,14 @@ extra-deps:
   commit: b9fca8beee0f23c17a6b2001ec834d071709e6e7
   subdirs:
     - packages/base
+  # Temporary fork of boolexpr
+- git: https://github.com/adinapoli/boolexpr.git
+  commit: 91928b5d7f9342e9865dde0d94862792d2b88779
   # Others dependencies (using stack resolver)
 - HSvm-0.1.1.3.22
 - KMP-0.2.0.0@sha256:6dfbac03ef00ebd9347234732cb86a40f62ab5a80c0cc6bedb8eb51766f7df28,2562
 - MissingH-1.4.3.0@sha256:32f9892ec98cd21df4f4d3ed8d95a3831ae74287ea0641d6f09b2dc6ef061d39,4859
 - Unique-0.4.7.8@sha256:9661f45aa31dde119a2114566166ea38b011a45653337045ee4ced75636533c0,2067
-- boolexpr-0.2
 - constraints-extras-0.3.1.0@sha256:12016ebb91ad5ed2c82bf7e48c6bd6947d164d33c9dca5ac3965de1bb6c780c0,1777
 - context-0.2.0.0@sha256:6b643adb4a64fe521873d08df0497f71f88e18b9ecff4b68b4eef938e446cfc9,1886
 - dependent-sum-0.7.1.0@sha256:0e419237f5b86da3659772afff9cab355c0f8d5b3fdb15a5b30e673d8dc83941,2147

test/Core/Text/Corpus/Query.hs

@@ -42,6 +42,10 @@ tests = withResource pubmedSettings (const (pure ())) $ \getPubmedKey ->
   , testProperty "Parses 'A AND B -C'   (left associative)" testParse05
   , testProperty "Parses 'A AND (B -C)' (right associative)" testParse05_01
   , testProperty "Parses (A OR B OR NOT C) AND (D OR E OR F) -(G OR H OR I)" testParse06
+  , testProperty "It supports '\"Haskell\" AND \"Idris\"'" testParse07
+  , testProperty "It supports 'Haskell AND Idris'" testParse07_01
+  , testProperty "It supports 'Raphael'" testParse07_02
+  , testProperty "It supports 'Niki', 'Ajeje' and 'Orf'" testParse07_03
   , testCase     "Parses words into a single constant" testWordsIntoConst
   , testGroup "Arxiv expression converter" [
       testCase "It supports 'A AND B'"     testArxiv01_01
@@ -124,6 +128,27 @@ testParse06 =
       )
     )
 
+testParse07 :: Property
+testParse07 =
+  translatesInto "\"Haskell\" AND \"Agda\""
+    ((BConst (Positive  "Haskell") `BAnd` (BConst (Positive  "Agda"))))
+
+testParse07_01 :: Property
+testParse07_01 =
+  translatesInto "Haskell AND Agda"
+    ((BConst (Positive  "Haskell") `BAnd` (BConst (Positive  "Agda"))))
+
+testParse07_02 :: Property
+testParse07_02 =
+  translatesInto "Raphael"
+    ((BConst (Positive  "Raphael")))
+
+testParse07_03 :: Property
+testParse07_03 =
+  translatesInto "Niki" ((BConst (Positive "Niki"))) .&&.
+  translatesInto "Ajeje" ((BConst (Positive "Ajeje"))) .&&.
+  translatesInto "Orf" ((BConst (Positive "Orf")))
+
 testWordsIntoConst :: Assertion
 testWordsIntoConst =
   let (expected :: BoolExpr Term) =