Skip to content
Projects
Groups
Snippets
Help
Loading...
Help
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
haskell-gargantext
Project
Project
Details
Activity
Releases
Cycle Analytics
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Charts
Issues
191
Issues
191
List
Board
Labels
Milestones
Merge Requests
8
Merge Requests
8
CI / CD
CI / CD
Pipelines
Jobs
Schedules
Charts
Wiki
Wiki
Snippets
Snippets
Members
Members
Collapse sidebar
Close sidebar
Activity
Graph
Charts
Create a new issue
Jobs
Commits
Issue Boards
Open sidebar
gargantext
haskell-gargantext
Commits
d01140be
Verified
Commit
d01140be
authored
Sep 10, 2025
by
Przemyslaw Kaminski
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
[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
Changes
2
Pipelines
2
Hide whitespace changes
Inline
Side-by-side
Showing
2 changed files
with
62 additions
and
17 deletions
+62
-17
Query.hs
src/Gargantext/Core/Text/Corpus/Query.hs
+2
-2
Query.hs
test/Test/Core/Text/Corpus/Query.hs
+60
-15
No files found.
src/Gargantext/Core/Text/Corpus/Query.hs
View file @
d01140be
...
...
@@ -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
View file @
d01140be
{-# 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
->
...
...
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment