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
...
@@ -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
...
...
test/Test/Core/Text/Corpus/Query.hs
View file @
d01140be
{-# 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
->
...
...
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