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
160
Issues
160
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
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