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
199
Issues
199
List
Board
Labels
Milestones
Merge Requests
12
Merge Requests
12
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
863694e6
Unverified
Commit
863694e6
authored
Mar 21, 2019
by
Nicolas Pouillard
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
[NGRAMS-API] mark some query params as required
parent
d556ab83
Changes
3
Hide whitespace changes
Inline
Side-by-side
Showing
3 changed files
with
34 additions
and
36 deletions
+34
-36
Ngrams.hs
src/Gargantext/API/Ngrams.hs
+25
-27
Node.hs
src/Gargantext/API/Node.hs
+6
-6
Metrics.hs
src/Gargantext/Database/Metrics.hs
+3
-3
No files found.
src/Gargantext/API/Ngrams.hs
View file @
863694e6
...
@@ -602,10 +602,13 @@ ngramsIdPatch = fromList $ catMaybes $ reverse [ replace (1::NgramsId) (Just $ n
...
@@ -602,10 +602,13 @@ ngramsIdPatch = fromList $ catMaybes $ reverse [ replace (1::NgramsId) (Just $ n
------------------------------------------------------------------------
------------------------------------------------------------------------
------------------------------------------------------------------------
------------------------------------------------------------------------
-- TODO: find a better place for this Gargantext.API.{Common|Prelude|Core} ?
type
QueryParamR
=
QueryParam'
'[
R
equired
,
Strict
]
type
TableNgramsApiGet
=
Summary
" Table Ngrams API Get"
type
TableNgramsApiGet
=
Summary
" Table Ngrams API Get"
:>
QueryParam
"ngramsType"
TabType
:>
QueryParam
R
"ngramsType"
TabType
:>
QueryParam
s
"list"
ListId
:>
QueryParam
R
"list"
ListId
:>
QueryParam
"limit"
Limit
:>
QueryParam
R
"limit"
Limit
:>
QueryParam
"offset"
Offset
:>
QueryParam
"offset"
Offset
:>
QueryParam
"listType"
ListType
:>
QueryParam
"listType"
ListType
:>
QueryParam
"minTermSize"
Int
:>
QueryParam
"minTermSize"
Int
...
@@ -614,8 +617,8 @@ type TableNgramsApiGet = Summary " Table Ngrams API Get"
...
@@ -614,8 +617,8 @@ type TableNgramsApiGet = Summary " Table Ngrams API Get"
:>
Get
'[
J
SON
]
(
Versioned
NgramsTable
)
:>
Get
'[
J
SON
]
(
Versioned
NgramsTable
)
type
TableNgramsApi
=
Summary
" Table Ngrams API Change"
type
TableNgramsApi
=
Summary
" Table Ngrams API Change"
:>
QueryParam
"ngramsType"
TabType
:>
QueryParam
R
"ngramsType"
TabType
:>
QueryParam
'
'[
R
equired
,
Strict
]
"list"
ListId
:>
QueryParam
R
"list"
ListId
:>
ReqBody
'[
J
SON
]
(
Versioned
NgramsTablePatch
)
:>
ReqBody
'[
J
SON
]
(
Versioned
NgramsTablePatch
)
:>
Put
'[
J
SON
]
(
Versioned
NgramsTablePatch
)
:>
Put
'[
J
SON
]
(
Versioned
NgramsTablePatch
)
...
@@ -658,17 +661,15 @@ mkChildrenGroups addOrRem nt patches =
...
@@ -658,17 +661,15 @@ mkChildrenGroups addOrRem nt patches =
]
]
-}
-}
ngramsTypeFromTabType
::
Maybe
TabType
->
NgramsType
ngramsTypeFromTabType
::
TabType
->
NgramsType
ngramsTypeFromTabType
maybeT
abType
=
ngramsTypeFromTabType
t
abType
=
let
lieu
=
"Garg.API.Ngrams: "
::
Text
in
let
lieu
=
"Garg.API.Ngrams: "
::
Text
in
case
maybeTabType
of
case
tabType
of
Nothing
->
panic
(
lieu
<>
"Indicate the Table"
)
Sources
->
Ngrams
.
Sources
Just
tab
->
case
tab
of
Authors
->
Ngrams
.
Authors
Sources
->
Ngrams
.
Sources
Institutes
->
Ngrams
.
Institutes
Authors
->
Ngrams
.
Authors
Terms
->
Ngrams
.
NgramsTerms
Institutes
->
Ngrams
.
Institutes
_
->
panic
$
lieu
<>
"No Ngrams for this tab"
Terms
->
Ngrams
.
NgramsTerms
_
->
panic
$
lieu
<>
"No Ngrams for this tab"
------------------------------------------------------------------------
------------------------------------------------------------------------
data
Repo
s
p
=
Repo
data
Repo
s
p
=
Repo
...
@@ -827,12 +828,12 @@ putListNgrams listId ngramsType nes = do
...
@@ -827,12 +828,12 @@ putListNgrams listId ngramsType nes = do
-- client.
-- client.
tableNgramsPatch
::
(
HasNgramError
err
,
HasInvalidError
err
,
tableNgramsPatch
::
(
HasNgramError
err
,
HasInvalidError
err
,
RepoCmdM
env
err
m
)
RepoCmdM
env
err
m
)
=>
CorpusId
->
Maybe
TabType
->
ListId
=>
CorpusId
->
TabType
->
ListId
->
Versioned
NgramsTablePatch
->
Versioned
NgramsTablePatch
->
m
(
Versioned
NgramsTablePatch
)
->
m
(
Versioned
NgramsTablePatch
)
tableNgramsPatch
_corpusId
maybeT
abType
listId
(
Versioned
p_version
p_table
)
tableNgramsPatch
_corpusId
t
abType
listId
(
Versioned
p_version
p_table
)
|
p_table
==
mempty
=
do
|
p_table
==
mempty
=
do
let
ngramsType
=
ngramsTypeFromTabType
maybeT
abType
let
ngramsType
=
ngramsTypeFromTabType
t
abType
var
<-
view
repoVar
var
<-
view
repoVar
r
<-
liftIO
$
readMVar
var
r
<-
liftIO
$
readMVar
var
...
@@ -844,7 +845,7 @@ tableNgramsPatch _corpusId maybeTabType listId (Versioned p_version p_table)
...
@@ -844,7 +845,7 @@ tableNgramsPatch _corpusId maybeTabType listId (Versioned p_version p_table)
pure
(
Versioned
(
r
^.
r_version
)
q_table
)
pure
(
Versioned
(
r
^.
r_version
)
q_table
)
|
otherwise
=
do
|
otherwise
=
do
let
ngramsType
=
ngramsTypeFromTabType
maybeT
abType
let
ngramsType
=
ngramsTypeFromTabType
t
abType
(
p0
,
p0_validity
)
=
PM
.
singleton
listId
p_table
(
p0
,
p0_validity
)
=
PM
.
singleton
listId
p_table
(
p
,
p_validity
)
=
PM
.
singleton
ngramsType
p0
(
p
,
p_validity
)
=
PM
.
singleton
ngramsType
p0
...
@@ -893,20 +894,18 @@ type MaxSize = Int
...
@@ -893,20 +894,18 @@ type MaxSize = Int
-- | Table of Ngrams is a ListNgrams formatted (sorted and/or cut).
-- | Table of Ngrams is a ListNgrams formatted (sorted and/or cut).
-- TODO: should take only one ListId
-- TODO: should take only one ListId
getTableNgrams
::
(
RepoCmdM
env
err
m
,
HasNodeError
err
,
HasConnection
env
)
getTableNgrams
::
(
RepoCmdM
env
err
m
,
HasNodeError
err
,
HasConnection
env
)
=>
CorpusId
->
Maybe
TabType
=>
CorpusId
->
TabType
->
[
ListId
]
->
Maybe
Limit
->
Maybe
Offset
->
ListId
->
Limit
->
Maybe
Offset
->
Maybe
ListType
->
Maybe
ListType
->
Maybe
MinSize
->
Maybe
MaxSize
->
Maybe
MinSize
->
Maybe
MaxSize
->
Maybe
Text
-- full text search
->
Maybe
Text
-- full text search
->
m
(
Versioned
NgramsTable
)
->
m
(
Versioned
NgramsTable
)
getTableNgrams
cId
maybeTabType
listIds
mlimit
moffset
getTableNgrams
cId
tabType
listId
limit_
moffset
mlistType
mminSize
mmaxSize
msearchQuery
=
do
mlistType
mminSize
mmaxSize
msearchQuery
=
do
let
ngramsType
=
ngramsTypeFromTabType
maybeT
abType
let
ngramsType
=
ngramsTypeFromTabType
t
abType
let
let
defaultLimit
=
10
-- TODO
offset_
=
maybe
0
identity
moffset
limit_
=
maybe
defaultLimit
identity
mlimit
offset_
=
maybe
0
identity
moffset
listType
=
maybe
(
const
True
)
(
==
)
mlistType
listType
=
maybe
(
const
True
)
(
==
)
mlistType
minSize
=
maybe
(
const
True
)
(
<=
)
mminSize
minSize
=
maybe
(
const
True
)
(
<=
)
mminSize
maxSize
=
maybe
(
const
True
)
(
>=
)
mmaxSize
maxSize
=
maybe
(
const
True
)
(
>=
)
mmaxSize
...
@@ -933,7 +932,6 @@ getTableNgrams cId maybeTabType listIds mlimit moffset
...
@@ -933,7 +932,6 @@ getTableNgrams cId maybeTabType listIds mlimit moffset
-- lists <- catMaybes <$> listsWith userMaster
-- lists <- catMaybes <$> listsWith userMaster
-- trace (show lists) $
-- trace (show lists) $
-- getNgramsTableMap ({-lists <>-} listIds) ngramsType
-- getNgramsTableMap ({-lists <>-} listIds) ngramsType
let
listId
=
fromMaybe
(
panic
"getTableNgrams: expecting a single ListId"
)
(
head
listIds
)
table
<-
getNgramsTableMap
listId
ngramsType
&
mapped
.
v_data
%~
finalize
table
<-
getNgramsTableMap
listId
ngramsType
&
mapped
.
v_data
%~
finalize
occurrences
<-
getOccByNgramsOnly
cId
ngramsType
(
table
^..
v_data
.
_NgramsTable
.
each
.
ne_ngrams
)
occurrences
<-
getOccByNgramsOnly
cId
ngramsType
(
table
^..
v_data
.
_NgramsTable
.
each
.
ne_ngrams
)
...
...
src/Gargantext/API/Node.hs
View file @
863694e6
...
@@ -41,7 +41,7 @@ import Data.Text (Text())
...
@@ -41,7 +41,7 @@ import Data.Text (Text())
import
Data.Time
(
UTCTime
)
import
Data.Time
(
UTCTime
)
import
GHC.Generics
(
Generic
)
import
GHC.Generics
(
Generic
)
import
Gargantext.API.Metrics
import
Gargantext.API.Metrics
import
Gargantext.API.Ngrams
(
TabType
(
..
),
TableNgramsApi
,
TableNgramsApiGet
,
tableNgramsPatch
,
getTableNgrams
,
HasRepo
)
import
Gargantext.API.Ngrams
(
TabType
(
..
),
TableNgramsApi
,
TableNgramsApiGet
,
tableNgramsPatch
,
getTableNgrams
,
HasRepo
,
QueryParamR
)
import
Gargantext.API.Ngrams.Tools
import
Gargantext.API.Ngrams.Tools
import
Gargantext.API.Search
(
SearchAPI
,
searchIn
,
SearchInQuery
)
import
Gargantext.API.Search
(
SearchAPI
,
searchIn
,
SearchInQuery
)
import
Gargantext.Core.Types
(
Offset
,
Limit
,
ListType
(
..
))
import
Gargantext.Core.Types
(
Offset
,
Limit
,
ListType
(
..
))
...
@@ -388,14 +388,14 @@ query s = pure s
...
@@ -388,14 +388,14 @@ query s = pure s
-------------------------------------------------------------------------------
-------------------------------------------------------------------------------
type
MetricsAPI
=
Summary
"SepGen IncExc metrics"
type
MetricsAPI
=
Summary
"SepGen IncExc metrics"
:>
QueryParam
"list"
ListId
:>
QueryParam
"list"
ListId
:>
QueryParam
"ngramsType"
TabType
:>
QueryParam
R
"ngramsType"
TabType
:>
QueryParam
"limit"
Int
:>
QueryParam
"limit"
Int
:>
Get
'[
J
SON
]
Metrics
:>
Get
'[
J
SON
]
Metrics
getMetrics
::
NodeId
->
GargServer
MetricsAPI
getMetrics
::
NodeId
->
GargServer
MetricsAPI
getMetrics
cId
maybeListId
maybeT
abType
maybeLimit
=
do
getMetrics
cId
maybeListId
t
abType
maybeLimit
=
do
(
ngs'
,
scores
)
<-
getMetrics'
cId
maybeListId
maybeT
abType
maybeLimit
(
ngs'
,
scores
)
<-
getMetrics'
cId
maybeListId
t
abType
maybeLimit
let
let
metrics
=
map
(
\
(
Scored
t
s1
s2
)
->
Metric
t
s1
s2
(
listType
t
ngs'
))
scores
metrics
=
map
(
\
(
Scored
t
s1
s2
)
->
Metric
t
s1
s2
(
listType
t
ngs'
))
scores
...
...
src/Gargantext/Database/Metrics.hs
View file @
863694e6
...
@@ -33,15 +33,15 @@ import Servant (ServantErr)
...
@@ -33,15 +33,15 @@ import Servant (ServantErr)
import
qualified
Data.Map
as
Map
import
qualified
Data.Map
as
Map
getMetrics'
::
FlowCmdM
env
ServantErr
m
getMetrics'
::
FlowCmdM
env
ServantErr
m
=>
CorpusId
->
Maybe
ListId
->
Maybe
TabType
->
Maybe
Limit
=>
CorpusId
->
Maybe
ListId
->
TabType
->
Maybe
Limit
->
m
(
Map
Text
(
ListType
,
Maybe
Text
),
[
Scored
Text
])
->
m
(
Map
Text
(
ListType
,
Maybe
Text
),
[
Scored
Text
])
getMetrics'
cId
maybeListId
maybeT
abType
maybeLimit
=
do
getMetrics'
cId
maybeListId
t
abType
maybeLimit
=
do
lId
<-
case
maybeListId
of
lId
<-
case
maybeListId
of
Nothing
->
defaultList
cId
Nothing
->
defaultList
cId
Just
lId'
->
pure
lId'
Just
lId'
->
pure
lId'
let
ngramsType
=
ngramsTypeFromTabType
maybeT
abType
let
ngramsType
=
ngramsTypeFromTabType
t
abType
ngs'
<-
mapTermListRoot
[
lId
]
ngramsType
ngs'
<-
mapTermListRoot
[
lId
]
ngramsType
let
ngs
=
Map
.
unions
$
map
(
\
t
->
filterListWithRoot
t
ngs'
)
let
ngs
=
Map
.
unions
$
map
(
\
t
->
filterListWithRoot
t
ngs'
)
...
...
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