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

Added tests.
parent 062f0c68
Pipeline #7879 passed with stages
in 43 minutes and 18 seconds
...@@ -113,12 +113,12 @@ queryTermToken = do ...@@ -113,12 +113,12 @@ queryTermToken = do
'"' : '~' : rest '"' : '~' : rest
-> QT_partial_match (Term $ T.pack $ '"' : rest) -> QT_partial_match (Term $ T.pack $ '"' : rest)
'~' : rest '~' : rest
-> QT_partial_match (Term $ T.pack $ '"' : rest) -> QT_partial_match (Term $ T.pack rest)
_ _
-> QT_exact_match (Term $ T.pack t) -> QT_exact_match (Term $ T.pack t)
termToken :: CharParser st [Term] 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 where
dubQuote = BoolExpr.symbol "\"" dubQuote = BoolExpr.symbol "\""
multipleTerms = map (Term . T.pack) <$> sepBy BoolExpr.identifier BoolExpr.whiteSpace multipleTerms = map (Term . T.pack) <$> sepBy BoolExpr.identifier BoolExpr.whiteSpace
......
{-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeApplications #-}
module Test.Core.Text.Corpus.Query (tests) where module Test.Core.Text.Corpus.Query (tests) where
import Data.BoolExpr import Data.BoolExpr
import Data.Conduit import Data.Conduit ( sourceToList )
import Data.String import Data.String ( IsString(..) )
import Data.Text qualified as T
import Gargantext.Core (Lang(..)) 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.Core.Text.Corpus.Query
import Gargantext.Database.Admin.Types.Hyperdata (HyperdataDocument(..)) import Gargantext.Database.Admin.Types.Hyperdata (HyperdataDocument(..))
import Network.Api.Arxiv qualified as Arxiv
import Prelude import Prelude
import System.Environment import System.Environment ( lookupEnv )
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 Test.HUnit import Test.HUnit
import Test.Hspec import Test.Hspec
...@@ -34,6 +35,7 @@ tests = do ...@@ -34,6 +35,7 @@ tests = do
describe "Boolean Query Engine" $ do describe "Boolean Query Engine" $ do
prop "Parses 'A OR B'" testParse01 prop "Parses 'A OR B'" testParse01
prop "Parses 'A AND B'" testParse02 prop "Parses 'A AND B'" testParse02
prop "Parses 'A B'" testParse02'
prop "Parses '-A'" testParse03 prop "Parses '-A'" testParse03
prop "Parses 'NOT A'" testParse03_01 prop "Parses 'NOT A'" testParse03_01
prop "Parses 'A -B'" testParse04 prop "Parses 'A -B'" testParse04
...@@ -46,6 +48,8 @@ tests = do ...@@ -46,6 +48,8 @@ tests = do
prop "It supports 'Raphael'" testParse07_02 prop "It supports 'Raphael'" testParse07_02
prop "It supports 'Niki', 'Ajeje' and 'Orf'" testParse07_03 prop "It supports 'Niki', 'Ajeje' and 'Orf'" testParse07_03
it "Parses words into a single constant" testWordsIntoConst 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 describe "Arxiv expression converter" $ do
it "It supports 'A AND B'" testArxiv01_01 it "It supports 'A AND B'" testArxiv01_01
it "It supports '\"Haskell\" AND \"Agda\"'" testArxiv01_02 it "It supports '\"Haskell\" AND \"Agda\"'" testArxiv01_02
...@@ -89,6 +93,9 @@ testParse01 = "A OR B" `translatesInto` (BConst (Positive ["A"]) `BOr` BConst (P ...@@ -89,6 +93,9 @@ testParse01 = "A OR B" `translatesInto` (BConst (Positive ["A"]) `BOr` BConst (P
testParse02 :: Property testParse02 :: Property
testParse02 = "A AND B" `translatesInto` (BConst (Positive ["A"]) `BAnd` BConst (Positive ["B"])) 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 :: Property
testParse03 = "-A" `translatesInto` (BConst (Negative ["A"])) testParse03 = "-A" `translatesInto` (BConst (Negative ["A"]))
...@@ -146,13 +153,51 @@ testParse07_03 = ...@@ -146,13 +153,51 @@ testParse07_03 =
testWordsIntoConst :: Assertion testWordsIntoConst :: Assertion
testWordsIntoConst = 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 in case parseQuery "\"The Art of Computer Programming\" AND \"Conceptual Mathematics\"" of
Left err Left err
-> assertBool err False -> assertBool err False
Right x Right x
-> fromCNF (getQuery x) @?= expected -> 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 -> (Query -> Assertion) -> Assertion
withValidQuery rawQuery onValidParse = do withValidQuery rawQuery onValidParse = do
case parseQuery rawQuery of case parseQuery rawQuery of
...@@ -163,38 +208,38 @@ withValidQuery rawQuery onValidParse = do ...@@ -163,38 +208,38 @@ withValidQuery rawQuery onValidParse = do
testArxiv01_01 :: Assertion testArxiv01_01 :: Assertion
testArxiv01_01 = withValidQuery "A AND B" $ \q -> testArxiv01_01 = withValidQuery "A AND B" $ \q ->
assertBool ("Query not converted into expression: " <> show @(BoolExpr [QueryTerm]) (fromCNF $ getQuery 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 :: Assertion
testArxiv01_02 = withValidQuery "\"Haskell\" AND \"Agda\"" $ \q -> testArxiv01_02 = withValidQuery "\"Haskell\" AND \"Agda\"" $ \q ->
assertBool ("Query not converted into expression: " <> show @(BoolExpr [QueryTerm]) (fromCNF $ getQuery 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 :: Assertion
testArxiv02 = withValidQuery "A OR B" $ \q -> testArxiv02 = withValidQuery "A OR B" $ \q ->
assertBool ("Query not converted into expression: " <> show @(BoolExpr [QueryTerm]) (fromCNF $ getQuery 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 :: Assertion
testArxiv03_01 = withValidQuery "A AND NOT B" $ \q -> testArxiv03_01 = withValidQuery "A AND NOT B" $ \q ->
assertBool ("Query not converted into expression: " <> show @(BoolExpr [QueryTerm]) (fromCNF $ getQuery 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 :: Assertion
testArxiv03_02 = withValidQuery "A AND -B" $ \q -> testArxiv03_02 = withValidQuery "A AND -B" $ \q ->
assertBool ("Query not converted into expression: " <> show @(BoolExpr [QueryTerm]) (fromCNF $ getQuery 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. -- Double negation get turned into positive.
testArxiv04_01 :: Assertion testArxiv04_01 :: Assertion
testArxiv04_01 = withValidQuery "A AND NOT (NOT B)" $ \q -> testArxiv04_01 = withValidQuery "A AND NOT (NOT B)" $ \q ->
assertBool ("Query not converted into expression: " <> show @(BoolExpr [QueryTerm]) (fromCNF $ getQuery 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 :: Assertion
testArxiv04_02 = withValidQuery "A AND NOT (NOT (NOT B))" $ \q -> testArxiv04_02 = withValidQuery "A AND NOT (NOT (NOT B))" $ \q ->
assertBool ("Query not converted into expression: " <> show @(BoolExpr [QueryTerm]) (fromCNF $ getQuery 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 :: Assertion
testArxiv05 = withValidQuery "A OR NOT B" $ \q -> testArxiv05 = withValidQuery "A OR NOT B" $ \q ->
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment