[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
'"' : '~' : 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
......
{-# 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 ->
......
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