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
148
Issues
148
List
Board
Labels
Milestones
Merge Requests
10
Merge Requests
10
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
e307e00a
Commit
e307e00a
authored
Oct 12, 2022
by
Karen Konou
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
[Docs table] handle year filter
parent
de1fddb3
Pipeline
#3287
passed with stage
in 94 minutes and 44 seconds
Changes
5
Pipelines
1
Hide whitespace changes
Inline
Side-by-side
Showing
5 changed files
with
38 additions
and
24 deletions
+38
-24
Client.hs
src/Gargantext/API/Client.hs
+3
-3
Export.hs
src/Gargantext/API/Node/Document/Export.hs
+1
-1
Table.hs
src/Gargantext/API/Table.hs
+15
-10
Learn.hs
src/Gargantext/Database/Action/Learn.hs
+3
-3
Facet.hs
src/Gargantext/Database/Query/Facet.hs
+16
-7
No files found.
src/Gargantext/API/Client.hs
View file @
e307e00a
...
@@ -106,7 +106,7 @@ waitUpdateNodeAsyncJob :: Token -> NodeId -> JobID 'Unsafe -> ClientM (JobOutput
...
@@ -106,7 +106,7 @@ waitUpdateNodeAsyncJob :: Token -> NodeId -> JobID 'Unsafe -> ClientM (JobOutput
deleteNode
::
Token
->
NodeId
->
ClientM
Int
deleteNode
::
Token
->
NodeId
->
ClientM
Int
getNodeChildren
::
Token
->
NodeId
->
Maybe
NodeType
->
Maybe
Int
->
Maybe
Int
->
ClientM
(
NodeTableResult
HyperdataAny
)
getNodeChildren
::
Token
->
NodeId
->
Maybe
NodeType
->
Maybe
Int
->
Maybe
Int
->
ClientM
(
NodeTableResult
HyperdataAny
)
getNodeTable
::
Token
->
NodeId
->
Maybe
TabType
->
Maybe
ListId
->
Maybe
Int
->
Maybe
Int
->
Maybe
Facet
.
OrderBy
->
Maybe
Text
->
ClientM
(
HashedResponse
FacetTableResult
)
getNodeTable
::
Token
->
NodeId
->
Maybe
TabType
->
Maybe
ListId
->
Maybe
Int
->
Maybe
Int
->
Maybe
Facet
.
OrderBy
->
Maybe
Text
->
Maybe
Text
->
ClientM
(
HashedResponse
FacetTableResult
)
postNodeTableQuery
::
Token
->
NodeId
->
TableQuery
->
ClientM
FacetTableResult
postNodeTableQuery
::
Token
->
NodeId
->
TableQuery
->
ClientM
FacetTableResult
getNodeTableHash
::
Token
->
NodeId
->
Maybe
TabType
->
ClientM
Text
getNodeTableHash
::
Token
->
NodeId
->
Maybe
TabType
->
ClientM
Text
...
@@ -195,7 +195,7 @@ waitUpdateCorpusAsyncJob :: Token -> CorpusId -> JobID 'Unsafe -> ClientM (JobOu
...
@@ -195,7 +195,7 @@ waitUpdateCorpusAsyncJob :: Token -> CorpusId -> JobID 'Unsafe -> ClientM (JobOu
deleteCorpus
::
Token
->
CorpusId
->
ClientM
Int
deleteCorpus
::
Token
->
CorpusId
->
ClientM
Int
getCorpusChildren
::
Token
->
CorpusId
->
Maybe
NodeType
->
Maybe
Int
->
Maybe
Int
->
ClientM
(
NodeTableResult
HyperdataCorpus
)
getCorpusChildren
::
Token
->
CorpusId
->
Maybe
NodeType
->
Maybe
Int
->
Maybe
Int
->
ClientM
(
NodeTableResult
HyperdataCorpus
)
getCorpusTable
::
Token
->
CorpusId
->
Maybe
TabType
->
Maybe
ListId
->
Maybe
Int
->
Maybe
Int
->
Maybe
Facet
.
OrderBy
->
Maybe
Text
->
ClientM
(
HashedResponse
FacetTableResult
)
getCorpusTable
::
Token
->
CorpusId
->
Maybe
TabType
->
Maybe
ListId
->
Maybe
Int
->
Maybe
Int
->
Maybe
Facet
.
OrderBy
->
Maybe
Text
->
Maybe
Text
->
ClientM
(
HashedResponse
FacetTableResult
)
postCorpusTableQuery
::
Token
->
CorpusId
->
TableQuery
->
ClientM
FacetTableResult
postCorpusTableQuery
::
Token
->
CorpusId
->
TableQuery
->
ClientM
FacetTableResult
getCorpusTableHash
::
Token
->
CorpusId
->
Maybe
TabType
->
ClientM
Text
getCorpusTableHash
::
Token
->
CorpusId
->
Maybe
TabType
->
ClientM
Text
...
@@ -290,7 +290,7 @@ waitUpdateAnnuaireAsyncJob :: Token -> AnnuaireId -> JobID 'Unsafe -> ClientM (J
...
@@ -290,7 +290,7 @@ waitUpdateAnnuaireAsyncJob :: Token -> AnnuaireId -> JobID 'Unsafe -> ClientM (J
deleteAnnuaire
::
Token
->
AnnuaireId
->
ClientM
Int
deleteAnnuaire
::
Token
->
AnnuaireId
->
ClientM
Int
getAnnuaireChildren
::
Token
->
AnnuaireId
->
Maybe
NodeType
->
Maybe
Int
->
Maybe
Int
->
ClientM
(
NodeTableResult
HyperdataAnnuaire
)
getAnnuaireChildren
::
Token
->
AnnuaireId
->
Maybe
NodeType
->
Maybe
Int
->
Maybe
Int
->
ClientM
(
NodeTableResult
HyperdataAnnuaire
)
getAnnuaireTable
::
Token
->
AnnuaireId
->
Maybe
TabType
->
Maybe
ListId
->
Maybe
Int
->
Maybe
Int
->
Maybe
Facet
.
OrderBy
->
Maybe
Text
->
ClientM
(
HashedResponse
FacetTableResult
)
getAnnuaireTable
::
Token
->
AnnuaireId
->
Maybe
TabType
->
Maybe
ListId
->
Maybe
Int
->
Maybe
Int
->
Maybe
Facet
.
OrderBy
->
Maybe
Text
->
Maybe
Text
->
ClientM
(
HashedResponse
FacetTableResult
)
postAnnuaireTableQuery
::
Token
->
AnnuaireId
->
TableQuery
->
ClientM
FacetTableResult
postAnnuaireTableQuery
::
Token
->
AnnuaireId
->
TableQuery
->
ClientM
FacetTableResult
getAnnuaireTableHash
::
Token
->
AnnuaireId
->
Maybe
TabType
->
ClientM
Text
getAnnuaireTableHash
::
Token
->
AnnuaireId
->
Maybe
TabType
->
ClientM
Text
...
...
src/Gargantext/API/Node/Document/Export.hs
View file @
e307e00a
...
@@ -40,7 +40,7 @@ getDocumentsJSON :: UserId
...
@@ -40,7 +40,7 @@ getDocumentsJSON :: UserId
getDocumentsJSON
uId
pId
=
do
getDocumentsJSON
uId
pId
=
do
mcId
<-
getClosestParentIdByType
pId
NodeCorpus
mcId
<-
getClosestParentIdByType
pId
NodeCorpus
let
cId
=
maybe
(
panic
"[G.A.N.D.Export] Node has no parent"
)
identity
mcId
let
cId
=
maybe
(
panic
"[G.A.N.D.Export] Node has no parent"
)
identity
mcId
docs
<-
runViewDocuments
cId
False
Nothing
Nothing
Nothing
Nothing
docs
<-
runViewDocuments
cId
False
Nothing
Nothing
Nothing
Nothing
Nothing
pure
$
DocumentExport
{
_de_documents
=
mapFacetDoc
<$>
docs
pure
$
DocumentExport
{
_de_documents
=
mapFacetDoc
<$>
docs
,
_de_garg_version
=
T
.
pack
$
showVersion
PG
.
version
}
,
_de_garg_version
=
T
.
pack
$
showVersion
PG
.
version
}
where
where
...
...
src/Gargantext/API/Table.hs
View file @
e307e00a
...
@@ -61,6 +61,7 @@ type TableApi = Summary "Table API"
...
@@ -61,6 +61,7 @@ type TableApi = Summary "Table API"
:>
QueryParam
"offset"
Int
:>
QueryParam
"offset"
Int
:>
QueryParam
"orderBy"
OrderBy
:>
QueryParam
"orderBy"
OrderBy
:>
QueryParam
"query"
Text
:>
QueryParam
"query"
Text
:>
QueryParam
"year"
Text
:>
Get
'[
J
SON
]
(
HashedResponse
FacetTableResult
)
:>
Get
'[
J
SON
]
(
HashedResponse
FacetTableResult
)
:<|>
Summary
"Table API (POST)"
:<|>
Summary
"Table API (POST)"
:>
ReqBody
'[
J
SON
]
TableQuery
:>
ReqBody
'[
J
SON
]
TableQuery
...
@@ -106,14 +107,16 @@ getTableApi :: NodeId
...
@@ -106,14 +107,16 @@ getTableApi :: NodeId
->
Maybe
Int
->
Maybe
Int
->
Maybe
OrderBy
->
Maybe
OrderBy
->
Maybe
Text
->
Maybe
Text
->
Maybe
Text
->
Cmd
err
(
HashedResponse
FacetTableResult
)
->
Cmd
err
(
HashedResponse
FacetTableResult
)
getTableApi
cId
tabType
_mListId
mLimit
mOffset
mOrderBy
mQuery
=
do
getTableApi
cId
tabType
_mListId
mLimit
mOffset
mOrderBy
mQuery
mYear
=
do
printDebug
"[getTableApi] mQuery"
mQuery
printDebug
"[getTableApi] mQuery"
mQuery
t
<-
getTable
cId
tabType
mOffset
mLimit
mOrderBy
mQuery
printDebug
"[getTableApi] mYear"
mYear
t
<-
getTable
cId
tabType
mOffset
mLimit
mOrderBy
mQuery
mYear
pure
$
constructHashedResponse
t
pure
$
constructHashedResponse
t
postTableApi
::
NodeId
->
TableQuery
->
Cmd
err
FacetTableResult
postTableApi
::
NodeId
->
TableQuery
->
Cmd
err
FacetTableResult
postTableApi
cId
(
TableQuery
o
l
order
ft
""
)
=
getTable
cId
(
Just
ft
)
(
Just
o
)
(
Just
l
)
(
Just
order
)
Nothing
postTableApi
cId
(
TableQuery
o
l
order
ft
""
)
=
getTable
cId
(
Just
ft
)
(
Just
o
)
(
Just
l
)
(
Just
order
)
Nothing
Nothing
postTableApi
cId
(
TableQuery
o
l
order
ft
q
)
=
case
ft
of
postTableApi
cId
(
TableQuery
o
l
order
ft
q
)
=
case
ft
of
Docs
->
searchInCorpus'
cId
False
[
q
]
(
Just
o
)
(
Just
l
)
(
Just
order
)
Docs
->
searchInCorpus'
cId
False
[
q
]
(
Just
o
)
(
Just
l
)
(
Just
order
)
Trash
->
searchInCorpus'
cId
True
[
q
]
(
Just
o
)
(
Just
l
)
(
Just
order
)
Trash
->
searchInCorpus'
cId
True
[
q
]
(
Just
o
)
(
Just
l
)
(
Just
order
)
...
@@ -121,7 +124,7 @@ postTableApi cId (TableQuery o l order ft q) = case ft of
...
@@ -121,7 +124,7 @@ postTableApi cId (TableQuery o l order ft q) = case ft of
getTableHashApi
::
NodeId
->
Maybe
TabType
->
Cmd
err
Text
getTableHashApi
::
NodeId
->
Maybe
TabType
->
Cmd
err
Text
getTableHashApi
cId
tabType
=
do
getTableHashApi
cId
tabType
=
do
HashedResponse
{
hash
=
h
}
<-
getTableApi
cId
tabType
Nothing
Nothing
Nothing
Nothing
Nothing
HashedResponse
{
hash
=
h
}
<-
getTableApi
cId
tabType
Nothing
Nothing
Nothing
Nothing
Nothing
Nothing
pure
h
pure
h
searchInCorpus'
::
CorpusId
searchInCorpus'
::
CorpusId
...
@@ -143,10 +146,11 @@ getTable :: NodeId
...
@@ -143,10 +146,11 @@ getTable :: NodeId
->
Maybe
Limit
->
Maybe
Limit
->
Maybe
OrderBy
->
Maybe
OrderBy
->
Maybe
Text
->
Maybe
Text
->
Maybe
Text
->
Cmd
err
FacetTableResult
->
Cmd
err
FacetTableResult
getTable
cId
ft
o
l
order
query
=
do
getTable
cId
ft
o
l
order
query
year
=
do
docs
<-
getTable'
cId
ft
o
l
order
query
docs
<-
getTable'
cId
ft
o
l
order
query
year
docsCount
<-
runCountDocuments
cId
(
ft
==
Just
Trash
)
query
docsCount
<-
runCountDocuments
cId
(
ft
==
Just
Trash
)
query
year
pure
$
TableResult
{
tr_docs
=
docs
,
tr_count
=
docsCount
}
pure
$
TableResult
{
tr_docs
=
docs
,
tr_count
=
docsCount
}
getTable'
::
NodeId
getTable'
::
NodeId
...
@@ -155,11 +159,12 @@ getTable' :: NodeId
...
@@ -155,11 +159,12 @@ getTable' :: NodeId
->
Maybe
Limit
->
Maybe
Limit
->
Maybe
OrderBy
->
Maybe
OrderBy
->
Maybe
Text
->
Maybe
Text
->
Maybe
Text
->
Cmd
err
[
FacetDoc
]
->
Cmd
err
[
FacetDoc
]
getTable'
cId
ft
o
l
order
query
=
getTable'
cId
ft
o
l
order
query
year
=
case
ft
of
case
ft
of
(
Just
Docs
)
->
runViewDocuments
cId
False
o
l
order
query
(
Just
Docs
)
->
runViewDocuments
cId
False
o
l
order
query
year
(
Just
Trash
)
->
runViewDocuments
cId
True
o
l
order
query
(
Just
Trash
)
->
runViewDocuments
cId
True
o
l
order
query
year
(
Just
MoreFav
)
->
moreLike
cId
o
l
order
IsFav
(
Just
MoreFav
)
->
moreLike
cId
o
l
order
IsFav
(
Just
MoreTrash
)
->
moreLike
cId
o
l
order
IsTrash
(
Just
MoreTrash
)
->
moreLike
cId
o
l
order
IsTrash
x
->
panic
$
"not implemented in getTable: "
<>
(
cs
$
show
x
)
x
->
panic
$
"not implemented in getTable: "
<>
(
cs
$
show
x
)
...
...
src/Gargantext/Database/Action/Learn.hs
View file @
e307e00a
...
@@ -44,10 +44,10 @@ getPriors :: HasDBid NodeType => FavOrTrash -> CorpusId -> Cmd err (Events Bool)
...
@@ -44,10 +44,10 @@ getPriors :: HasDBid NodeType => FavOrTrash -> CorpusId -> Cmd err (Events Bool)
getPriors
ft
cId
=
do
getPriors
ft
cId
=
do
docs_fav
<-
filter
(
\
(
FacetDoc
_
_
_
_
f
_
_
)
->
f
==
Just
2
)
docs_fav
<-
filter
(
\
(
FacetDoc
_
_
_
_
f
_
_
)
->
f
==
Just
2
)
<$>
runViewDocuments
cId
False
Nothing
Nothing
Nothing
Nothing
<$>
runViewDocuments
cId
False
Nothing
Nothing
Nothing
Nothing
Nothing
docs_trash
<-
List
.
take
(
List
.
length
docs_fav
)
docs_trash
<-
List
.
take
(
List
.
length
docs_fav
)
<$>
runViewDocuments
cId
True
Nothing
Nothing
Nothing
Nothing
<$>
runViewDocuments
cId
True
Nothing
Nothing
Nothing
Nothing
Nothing
let
priors
=
priorEventsWith
text
(
fav2bool
ft
)
(
List
.
zip
(
repeat
False
)
docs_fav
let
priors
=
priorEventsWith
text
(
fav2bool
ft
)
(
List
.
zip
(
repeat
False
)
docs_fav
...
@@ -62,7 +62,7 @@ moreLikeWith :: HasDBid NodeType
...
@@ -62,7 +62,7 @@ moreLikeWith :: HasDBid NodeType
moreLikeWith
cId
o
l
order
ft
priors
=
do
moreLikeWith
cId
o
l
order
ft
priors
=
do
docs_test
<-
filter
(
\
(
FacetDoc
_
_
_
_
f
_
_
)
->
f
==
Just
1
)
docs_test
<-
filter
(
\
(
FacetDoc
_
_
_
_
f
_
_
)
->
f
==
Just
1
)
<$>
runViewDocuments
cId
False
o
Nothing
order
Nothing
<$>
runViewDocuments
cId
False
o
Nothing
order
Nothing
Nothing
let
results
=
map
fst
let
results
=
map
fst
$
filter
((
==
)
(
Just
$
not
$
fav2bool
ft
)
.
snd
)
$
filter
((
==
)
(
Just
$
not
$
fav2bool
ft
)
.
snd
)
...
...
src/Gargantext/Database/Query/Facet.hs
View file @
e307e00a
...
@@ -301,26 +301,28 @@ runViewDocuments :: HasDBid NodeType
...
@@ -301,26 +301,28 @@ runViewDocuments :: HasDBid NodeType
->
Maybe
Limit
->
Maybe
Limit
->
Maybe
OrderBy
->
Maybe
OrderBy
->
Maybe
Text
->
Maybe
Text
->
Maybe
Text
->
Cmd
err
[
FacetDoc
]
->
Cmd
err
[
FacetDoc
]
runViewDocuments
cId
t
o
l
order
query
=
do
runViewDocuments
cId
t
o
l
order
query
year
=
do
printDebug
"[runViewDocuments] sqlQuery"
$
showSql
sqlQuery
printDebug
"[runViewDocuments] sqlQuery"
$
showSql
sqlQuery
runOpaQuery
$
filterWith
o
l
order
sqlQuery
runOpaQuery
$
filterWith
o
l
order
sqlQuery
where
where
sqlQuery
=
viewDocuments
cId
t
(
toDBid
NodeDocument
)
query
sqlQuery
=
viewDocuments
cId
t
(
toDBid
NodeDocument
)
query
year
runCountDocuments
::
HasDBid
NodeType
=>
CorpusId
->
IsTrash
->
Maybe
Text
->
Cmd
err
Int
runCountDocuments
::
HasDBid
NodeType
=>
CorpusId
->
IsTrash
->
Maybe
Text
->
Maybe
Text
->
Cmd
err
Int
runCountDocuments
cId
t
mQuery
=
do
runCountDocuments
cId
t
mQuery
mYear
=
do
runCountOpaQuery
sqlQuery
runCountOpaQuery
sqlQuery
where
where
sqlQuery
=
viewDocuments
cId
t
(
toDBid
NodeDocument
)
mQuery
sqlQuery
=
viewDocuments
cId
t
(
toDBid
NodeDocument
)
mQuery
mYear
viewDocuments
::
CorpusId
viewDocuments
::
CorpusId
->
IsTrash
->
IsTrash
->
NodeTypeId
->
NodeTypeId
->
Maybe
Text
->
Maybe
Text
->
Maybe
Text
->
Select
FacetDocRead
->
Select
FacetDocRead
viewDocuments
cId
t
ntId
mQuery
=
viewDocumentsQuery
cId
t
ntId
mQuery
>>>
proc
(
c
,
nc
)
->
do
viewDocuments
cId
t
ntId
mQuery
mYear
=
viewDocumentsQuery
cId
t
ntId
mQuery
mYear
>>>
proc
(
c
,
nc
)
->
do
returnA
-<
FacetDoc
{
facetDoc_id
=
_cs_id
c
returnA
-<
FacetDoc
{
facetDoc_id
=
_cs_id
c
,
facetDoc_created
=
_cs_date
c
,
facetDoc_created
=
_cs_date
c
,
facetDoc_title
=
_cs_name
c
,
facetDoc_title
=
_cs_name
c
...
@@ -334,8 +336,9 @@ viewDocumentsQuery :: CorpusId
...
@@ -334,8 +336,9 @@ viewDocumentsQuery :: CorpusId
->
IsTrash
->
IsTrash
->
NodeTypeId
->
NodeTypeId
->
Maybe
Text
->
Maybe
Text
->
Maybe
Text
->
Select
(
ContextSearchRead
,
NodeContextRead
)
->
Select
(
ContextSearchRead
,
NodeContextRead
)
viewDocumentsQuery
cId
t
ntId
mQuery
=
proc
()
->
do
viewDocumentsQuery
cId
t
ntId
mQuery
mYear
=
proc
()
->
do
c
<-
queryContextSearchTable
-<
()
c
<-
queryContextSearchTable
-<
()
nc
<-
queryNodeContextTable
-<
()
nc
<-
queryNodeContextTable
-<
()
restrict
-<
c
^.
cs_id
.==
nc
^.
nc_context_id
restrict
-<
c
^.
cs_id
.==
nc
^.
nc_context_id
...
@@ -346,14 +349,20 @@ viewDocumentsQuery cId t ntId mQuery = proc () -> do
...
@@ -346,14 +349,20 @@ viewDocumentsQuery cId t ntId mQuery = proc () -> do
let
let
query
=
(
fromMaybe
""
mQuery
)
query
=
(
fromMaybe
""
mQuery
)
year
=
(
fromMaybe
""
mYear
)
iLikeQuery
=
T
.
intercalate
""
[
"%"
,
query
,
"%"
]
iLikeQuery
=
T
.
intercalate
""
[
"%"
,
query
,
"%"
]
abstractLHS
h
=
fromNullable
(
sqlStrictText
""
)
abstractLHS
h
=
fromNullable
(
sqlStrictText
""
)
$
toNullable
h
.->>
(
sqlStrictText
"abstract"
)
$
toNullable
h
.->>
(
sqlStrictText
"abstract"
)
yearLHS
h
=
fromNullable
(
sqlStrictText
""
)
$
toNullable
h
.->>
(
sqlStrictText
"publication_year"
)
restrict
-<
restrict
-<
if
query
==
""
then
sqlBool
True
if
query
==
""
then
sqlBool
True
else
((
c
^.
cs_name
)
`
ilike
`
(
sqlStrictText
iLikeQuery
))
else
((
c
^.
cs_name
)
`
ilike
`
(
sqlStrictText
iLikeQuery
))
.||
((
abstractLHS
(
c
^.
cs_hyperdata
))
`
ilike
`
(
sqlStrictText
iLikeQuery
))
.||
((
abstractLHS
(
c
^.
cs_hyperdata
))
`
ilike
`
(
sqlStrictText
iLikeQuery
))
restrict
-<
if
year
==
""
then
sqlBool
True
else
(
yearLHS
(
c
^.
cs_hyperdata
))
.==
(
sqlStrictText
year
)
returnA
-<
(
c
,
nc
)
returnA
-<
(
c
,
nc
)
...
...
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