Merge branch 'dev-fix-prefix-query' into 'dev'

[query] a prefixed query like ~prefix should transform to 'prefix', not '"prefix'

See merge request !443

src/Gargantext/Core/Text/Corpus/Query.hs

@@ -113,12 +113,12 @@ queryTermToken = do
      '"' : '~' : rest
        -> QT_partial_match (Term $ T.pack $ '"' : rest)
      '~' : rest
-       -> QT_partial_match (Term $ T.pack $ '"' : rest)
+       -> QT_partial_match (Term $ T.pack rest)
      _
        -> QT_exact_match (Term $ T.pack t)
 
 termToken :: CharParser st [Term]
-termToken = (try ((:[]) . Term . T.pack <$> BoolExpr.identifier) <|> (between dubQuote dubQuote multipleTerms))
+termToken = try ((:[]) . Term . T.pack <$> BoolExpr.identifier) <|> (between dubQuote dubQuote multipleTerms)
   where
     dubQuote      = BoolExpr.symbol "\""
     multipleTerms = map (Term . T.pack) <$> sepBy BoolExpr.identifier BoolExpr.whiteSpace

test/Test/Core/Text/Corpus/Query.hs

 {-# LANGUAGE DerivingStrategies  #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeApplications    #-}
+
 module Test.Core.Text.Corpus.Query (tests) where
 
 import Data.BoolExpr
-import Data.Conduit
-import Data.String
+import Data.Conduit ( sourceToList )
+import Data.String ( IsString(..) )
+import Data.Text qualified as T
 import Gargantext.Core (Lang(..))
+import Gargantext.Core.Text.Corpus.API.Arxiv qualified as Arxiv
+import Gargantext.Core.Text.Corpus.API.Pubmed qualified as Pubmed
 import Gargantext.Core.Text.Corpus.Query
 import Gargantext.Database.Admin.Types.Hyperdata (HyperdataDocument(..))
+import Network.Api.Arxiv qualified as Arxiv
 import Prelude
-import System.Environment
-import qualified Data.Text as T
-import qualified Gargantext.Core.Text.Corpus.API.Arxiv as Arxiv
-import qualified Gargantext.Core.Text.Corpus.API.Pubmed as Pubmed
-import qualified Network.Api.Arxiv as Arxiv
+import System.Environment ( lookupEnv )
 
 import Test.HUnit
 import Test.Hspec
@@ -34,6 +35,7 @@ tests = do
   describe "Boolean Query Engine" $ do
     prop "Parses 'A OR B'" testParse01
     prop "Parses 'A AND B'" testParse02
+    prop "Parses 'A B'" testParse02'
     prop "Parses '-A'" testParse03
     prop "Parses 'NOT A'" testParse03_01
     prop "Parses 'A -B'" testParse04
@@ -46,6 +48,8 @@ tests = do
     prop "It supports 'Raphael'" testParse07_02
     prop "It supports 'Niki', 'Ajeje' and 'Orf'" testParse07_03
     it "Parses words into a single constant" testWordsIntoConst
+    it "Correctly parses partial match queries 01" testPartialMatch01
+    it "Correctly parses partial match queries 02" testPartialMatch02
   describe "Arxiv expression converter" $ do
     it "It supports 'A AND B'"     testArxiv01_01
     it "It supports '\"Haskell\" AND \"Agda\"'" testArxiv01_02
@@ -89,6 +93,9 @@ testParse01 = "A OR B" `translatesInto` (BConst (Positive ["A"]) `BOr` BConst (P
 testParse02 :: Property
 testParse02 = "A AND B" `translatesInto` (BConst (Positive ["A"]) `BAnd` BConst (Positive ["B"]))
 
+testParse02' :: Property
+testParse02' = "A B" `translatesInto` (BConst (Positive ["A"]) `BAnd` BConst (Positive ["B"]))
+
 testParse03 :: Property
 testParse03 = "-A" `translatesInto` (BConst (Negative ["A"]))
 
@@ -146,13 +153,51 @@ testParse07_03 =
 
 testWordsIntoConst :: Assertion
 testWordsIntoConst =
-  let (expected :: BoolExpr [QueryTerm]) = fromCNF (boolTreeToCNF @[QueryTerm] $ (BAnd (BOr (BConst (Positive [QT_exact_match "The",QT_exact_match "Art",QT_exact_match "of",QT_exact_match "Computer",QT_exact_match "Programming"])) BFalse) (BAnd (BOr (BConst (Positive [QT_exact_match "Conceptual",QT_exact_match "Mathematics"])) BFalse) BTrue)))
+  let (expected :: BoolExpr [QueryTerm]) =
+        fromCNF (boolTreeToCNF @[QueryTerm] (
+          BAnd (BOr (BConst (Positive [ QT_exact_match "The"
+                                      , QT_exact_match "Art"
+                                      , QT_exact_match "of"
+                                      , QT_exact_match "Computer"
+                                      , QT_exact_match "Programming" ]))
+                    BFalse)
+               (BAnd (BOr (BConst (Positive [ QT_exact_match "Conceptual"
+                                            , QT_exact_match "Mathematics" ]))
+                          BFalse)
+                     BTrue))
+                )
   in case parseQuery "\"The Art of Computer Programming\" AND \"Conceptual Mathematics\"" of
     Left err
       -> assertBool err False
     Right x
       -> fromCNF (getQuery x) @?= expected
 
+testPartialMatch01 :: Assertion
+testPartialMatch01 =
+  let (expected :: BoolExpr [QueryTerm]) =
+        fromCNF (boolTreeToCNF @[QueryTerm] (
+          BAnd (BConst (Positive [QT_partial_match "fibona"]))
+               (BConst (Positive [QT_exact_match "sequence"])))
+                )
+  in case parseQuery "~fibona AND sequence" of
+    Left err
+      -> assertBool err False
+    Right q
+      -> fromCNF (getQuery q) @?= expected
+
+testPartialMatch02 :: Assertion
+testPartialMatch02 =
+  let (expected :: BoolExpr [QueryTerm]) =
+        fromCNF (boolTreeToCNF @[QueryTerm] (
+          BAnd (BConst (Positive [ QT_partial_match "fibona"
+                                 , QT_exact_match "sequence" ]))
+               BTrue))
+  in case parseQuery "\"~fibona sequence\"" of
+    Left err
+      -> assertBool err False
+    Right q
+      -> fromCNF (getQuery q) @?= expected
+
 withValidQuery :: RawQuery -> (Query -> Assertion) -> Assertion
 withValidQuery rawQuery onValidParse = do
   case parseQuery rawQuery of
@@ -163,38 +208,38 @@ withValidQuery rawQuery onValidParse = do
 testArxiv01_01 :: Assertion
 testArxiv01_01 = withValidQuery "A AND B" $ \q ->
   assertBool ("Query not converted into expression: " <> show @(BoolExpr [QueryTerm]) (fromCNF $ getQuery q))
-             (Arxiv.qExp (Arxiv.convertQuery q) == Just (Arxiv.And (Arxiv.Exp $ Arxiv.Abs ["A"]) ((Arxiv.Exp $ Arxiv.Abs ["B"]))))
+             (Arxiv.qExp (Arxiv.convertQuery q) == Just (Arxiv.And (Arxiv.Exp $ Arxiv.Abs ["A"]) (Arxiv.Exp $ Arxiv.Abs ["B"])))
 
 testArxiv01_02 :: Assertion
 testArxiv01_02 = withValidQuery "\"Haskell\" AND \"Agda\"" $ \q ->
   assertBool ("Query not converted into expression: " <> show @(BoolExpr [QueryTerm]) (fromCNF $ getQuery q))
-             (Arxiv.qExp (Arxiv.convertQuery q) == Just (Arxiv.And (Arxiv.Exp $ Arxiv.Abs ["Haskell"]) ((Arxiv.Exp $ Arxiv.Abs ["Agda"]))))
+             (Arxiv.qExp (Arxiv.convertQuery q) == Just (Arxiv.And (Arxiv.Exp $ Arxiv.Abs ["Haskell"]) (Arxiv.Exp $ Arxiv.Abs ["Agda"])))
 
 testArxiv02 :: Assertion
 testArxiv02 = withValidQuery "A OR B" $ \q ->
   assertBool ("Query not converted into expression: " <> show @(BoolExpr [QueryTerm]) (fromCNF $ getQuery q))
-             (Arxiv.qExp (Arxiv.convertQuery q) == Just (Arxiv.Or (Arxiv.Exp $ Arxiv.Abs ["A"]) ((Arxiv.Exp $ Arxiv.Abs ["B"]))))
+             (Arxiv.qExp (Arxiv.convertQuery q) == Just (Arxiv.Or (Arxiv.Exp $ Arxiv.Abs ["A"]) (Arxiv.Exp $ Arxiv.Abs ["B"])))
 
 testArxiv03_01 :: Assertion
 testArxiv03_01 = withValidQuery "A AND NOT B" $ \q ->
   assertBool ("Query not converted into expression: " <> show @(BoolExpr [QueryTerm]) (fromCNF $ getQuery q))
-             (Arxiv.qExp (Arxiv.convertQuery q) == Just (Arxiv.AndNot (Arxiv.Exp $ Arxiv.Abs ["A"]) ((Arxiv.Exp $ Arxiv.Abs ["B"]))))
+             (Arxiv.qExp (Arxiv.convertQuery q) == Just (Arxiv.AndNot (Arxiv.Exp $ Arxiv.Abs ["A"]) (Arxiv.Exp $ Arxiv.Abs ["B"])))
 
 testArxiv03_02 :: Assertion
 testArxiv03_02 = withValidQuery "A AND -B" $ \q ->
   assertBool ("Query not converted into expression: " <> show @(BoolExpr [QueryTerm]) (fromCNF $ getQuery q))
-             (Arxiv.qExp (Arxiv.convertQuery q) == Just (Arxiv.AndNot (Arxiv.Exp $ Arxiv.Abs ["A"]) ((Arxiv.Exp $ Arxiv.Abs ["B"]))))
+             (Arxiv.qExp (Arxiv.convertQuery q) == Just (Arxiv.AndNot (Arxiv.Exp $ Arxiv.Abs ["A"]) (Arxiv.Exp $ Arxiv.Abs ["B"])))
 
 -- Double negation get turned into positive.
 testArxiv04_01 :: Assertion
 testArxiv04_01 = withValidQuery "A AND NOT (NOT B)" $ \q ->
   assertBool ("Query not converted into expression: " <> show @(BoolExpr [QueryTerm]) (fromCNF $ getQuery q))
-             (Arxiv.qExp (Arxiv.convertQuery q) == Just (Arxiv.And (Arxiv.Exp $ Arxiv.Abs ["A"]) ((Arxiv.Exp $ Arxiv.Abs ["B"]))))
+             (Arxiv.qExp (Arxiv.convertQuery q) == Just (Arxiv.And (Arxiv.Exp $ Arxiv.Abs ["A"]) (Arxiv.Exp $ Arxiv.Abs ["B"])))
 
 testArxiv04_02 :: Assertion
 testArxiv04_02 = withValidQuery "A AND NOT (NOT (NOT B))" $ \q ->
   assertBool ("Query not converted into expression: " <> show @(BoolExpr [QueryTerm]) (fromCNF $ getQuery q))
-             (Arxiv.qExp (Arxiv.convertQuery q) == Just (Arxiv.AndNot (Arxiv.Exp $ Arxiv.Abs ["A"]) ((Arxiv.Exp $ Arxiv.Abs ["B"]))))
+             (Arxiv.qExp (Arxiv.convertQuery q) == Just (Arxiv.AndNot (Arxiv.Exp $ Arxiv.Abs ["A"]) (Arxiv.Exp $ Arxiv.Abs ["B"])))
 
 testArxiv05 :: Assertion
 testArxiv05 = withValidQuery "A OR NOT B" $ \q ->