Skip to content
Projects
Groups
Snippets
Help
Loading...
Help
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
H
haskell-gargantext
Project
Project
Details
Activity
Releases
Cycle Analytics
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Charts
Issues
0
Issues
0
List
Board
Labels
Milestones
Merge Requests
0
Merge Requests
0
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
Przemyslaw Kaminski
haskell-gargantext
Commits
a76b46a9
Commit
a76b46a9
authored
Aug 28, 2020
by
Przemyslaw Kaminski
Browse files
Options
Browse Files
Download
Plain Diff
Merge branch 'dev' into dev-graph-screenshot
parents
35b8b782
b8d306d8
Changes
6
Hide whitespace changes
Inline
Side-by-side
Showing
6 changed files
with
36 additions
and
61 deletions
+36
-61
Metrics.hs
src/Gargantext/API/Metrics.hs
+24
-27
Ngrams.hs
src/Gargantext/API/Ngrams.hs
+5
-5
Node.hs
src/Gargantext/API/Node.hs
+1
-0
Flow.hs
src/Gargantext/Database/Action/Flow.hs
+0
-1
TFICF.hs
src/Gargantext/Text/Metrics/TFICF.hs
+2
-2
Chart.hs
src/Gargantext/Viz/Chart.hs
+4
-26
No files found.
src/Gargantext/API/Metrics.hs
View file @
a76b46a9
...
...
@@ -56,11 +56,10 @@ type ScatterAPI = Summary "SepGen IncExc metrics"
:>
QueryParamR
"ngramsType"
TabType
:>
QueryParam
"limit"
Int
:>
Post
'[
J
SON
]
()
:<|>
"hash"
:>
Summary
"Scatter Hash"
:>
QueryParam
"list"
ListId
:>
QueryParamR
"ngramsType"
TabType
:>
Get
'[
J
SON
]
Text
:<|>
"hash"
:>
Summary
"Scatter Hash"
:>
QueryParam
"list"
ListId
:>
QueryParamR
"ngramsType"
TabType
:>
Get
'[
J
SON
]
Text
scatterApi
::
NodeId
->
GargServer
ScatterAPI
scatterApi
id'
=
getScatter
id'
...
...
@@ -138,22 +137,21 @@ type ChartApi = Summary " Chart API"
:>
QueryParam
"list"
ListId
:>
QueryParamR
"ngramsType"
TabType
:>
Get
'[
J
SON
]
(
HashedResponse
(
ChartMetrics
Histo
))
:<|>
Summary
"Chart update"
:>
QueryParam
"list"
ListId
:>
QueryParamR
"ngramsType"
TabType
:>
QueryParam
"limit"
Int
:>
Post
'[
J
SON
]
()
:<|>
"hash"
:>
Summary
"Chart Hash"
:>
QueryParam
"list"
ListId
:>
QueryParamR
"ngramsType"
TabType
:>
Get
'[
J
SON
]
Text
:<|>
Summary
"Chart update"
:>
QueryParam
"list"
ListId
:>
QueryParamR
"ngramsType"
TabType
:>
QueryParam
"limit"
Int
:>
Post
'[
J
SON
]
()
:<|>
"hash"
:>
Summary
"Chart Hash"
:>
QueryParam
"list"
ListId
:>
QueryParamR
"ngramsType"
TabType
:>
Get
'[
J
SON
]
Text
chartApi
::
NodeId
->
GargServer
ChartApi
chartApi
id'
=
getChart
id'
:<|>
updateChart
id'
:<|>
getChartHash
id'
-- TODO add start / end
getChart
::
FlowCmdM
env
err
m
=>
CorpusId
...
...
@@ -220,16 +218,15 @@ type PieApi = Summary "Pie Chart"
:>
QueryParam
"list"
ListId
:>
QueryParamR
"ngramsType"
TabType
:>
Get
'[
J
SON
]
(
HashedResponse
(
ChartMetrics
Histo
))
:<|>
Summary
"Pie Chart update"
:>
QueryParam
"list"
ListId
:>
QueryParamR
"ngramsType"
TabType
:>
QueryParam
"limit"
Int
:>
Post
'[
J
SON
]
()
:<|>
"hash"
:>
Summary
"Pie Hash"
:>
QueryParam
"list"
ListId
:>
QueryParamR
"ngramsType"
TabType
:>
Get
'[
J
SON
]
Text
:<|>
Summary
"Pie Chart update"
:>
QueryParam
"list"
ListId
:>
QueryParamR
"ngramsType"
TabType
:>
QueryParam
"limit"
Int
:>
Post
'[
J
SON
]
()
:<|>
"hash"
:>
Summary
"Pie Hash"
:>
QueryParam
"list"
ListId
:>
QueryParamR
"ngramsType"
TabType
:>
Get
'[
J
SON
]
Text
pieApi
::
NodeId
->
GargServer
PieApi
pieApi
id'
=
getPie
id'
...
...
@@ -280,7 +277,7 @@ updatePie' cId maybeListId tabType _maybeLimit = do
node
<-
getNodeWith
listId
(
Proxy
::
Proxy
HyperdataList
)
let
hl
=
node
^.
node_hyperdata
p
<-
pie
Data
cId
(
ngramsTypeFromTabType
tabType
)
MapTerm
p
<-
chart
Data
cId
(
ngramsTypeFromTabType
tabType
)
MapTerm
_
<-
updateHyperdata
listId
$
hl
{
_hl_pie
=
Just
$
ChartMetrics
p
}
pure
$
ChartMetrics
p
...
...
src/Gargantext/API/Ngrams.hs
View file @
a76b46a9
...
...
@@ -163,11 +163,11 @@ instance FromHttpApiData TabType
parseUrlPiece
_
=
Left
"Unexpected value of TabType"
instance
ToParamSchema
TabType
instance
ToJSON
TabType
instance
FromJSON
TabType
instance
ToSchema
TabType
instance
Arbitrary
TabType
instance
ToParamSchema
TabType
instance
ToJSON
TabType
instance
FromJSON
TabType
instance
ToSchema
TabType
instance
Arbitrary
TabType
where
arbitrary
=
elements
[
minBound
..
maxBound
]
...
...
src/Gargantext/API/Node.hs
View file @
a76b46a9
...
...
@@ -217,6 +217,7 @@ nodeAPI p uId id' = withAccess (Proxy :: Proxy (NodeAPI a)) Proxy uId (PathNode
:<|>
pairs
id'
:<|>
getPair
id'
-- VIZ
:<|>
scatterApi
id'
:<|>
chartApi
id'
:<|>
pieApi
id'
...
...
src/Gargantext/Database/Action/Flow.hs
View file @
a76b46a9
...
...
@@ -219,7 +219,6 @@ flowCorpusUser l user corpusName ctype ids = do
_
<-
insertDefaultNode
NodeDashboard
userCorpusId
userId
_
<-
insertDefaultNode
NodeGraph
userCorpusId
userId
--
_
<-
mkPhylo
userCorpusId
userId
-- Annuaire Flow
-- _ <- mkAnnuaire rootUserId userId
pure
userCorpusId
...
...
src/Gargantext/Text/Metrics/TFICF.hs
View file @
a76b46a9
...
...
@@ -49,8 +49,8 @@ tficf :: TficfContext Count Total
->
TFICF
tficf
(
TficfInfra
(
Count
ic
)
(
Total
it
)
)
(
TficfSupra
(
Count
sc
)
(
Total
st
)
)
|
it
>=
ic
&&
st
>=
sc
&&
it
<=
st
=
(
ic
/
it
)
/
log
(
sc
/
st
)
|
otherwise
=
panic
$
"[ERR]"
<>
path
<>
" Frequency impossible"
|
it
>=
ic
&&
st
>=
sc
{-&& it <= st-}
=
(
ic
/
it
)
/
log
(
sc
/
st
)
|
otherwise
=
panic
$
"[ERR]"
<>
path
<>
" Frequency impossible"
tficf
_
_
=
panic
$
"[ERR]"
<>
path
<>
"Undefined for these contexts"
...
...
src/Gargantext/Viz/Chart.hs
View file @
a76b46a9
...
...
@@ -19,7 +19,6 @@ import Data.Map (toList)
import
qualified
Data.List
as
List
import
qualified
Data.Map
as
Map
import
Data.Maybe
(
catMaybes
)
import
Servant
import
Gargantext.Core.Types.Main
import
Gargantext.Database.Admin.Config
...
...
@@ -51,10 +50,10 @@ histoData cId = do
pure
(
Histo
ls
css
)
pie
Data
::
FlowCmdM
env
err
m
chart
Data
::
FlowCmdM
env
err
m
=>
CorpusId
->
NgramsType
->
ListType
->
m
Histo
pie
Data
cId
nt
lt
=
do
chart
Data
cId
nt
lt
=
do
ls'
<-
selectNodesWithUsername
NodeList
userMaster
ls
<-
map
(
_node_id
)
<$>
getListsWithParentId
cId
ts
<-
mapTermListRoot
ls
nt
<$>
getRepo
...
...
@@ -71,8 +70,6 @@ pieData cId nt lt = do
pure
(
Histo
dates
(
map
round
count
))
treeData
::
FlowCmdM
env
err
m
=>
CorpusId
->
NgramsType
->
ListType
->
m
[
MyTree
]
...
...
@@ -80,32 +77,13 @@ treeData cId nt lt = do
ls'
<-
selectNodesWithUsername
NodeList
userMaster
ls
<-
map
(
_node_id
)
<$>
getListsWithParentId
cId
ts
<-
mapTermListRoot
ls
nt
<$>
getRepo
let
dico
=
filterListWithRoot
lt
ts
terms
=
catMaybes
$
List
.
concat
$
map
(
\
(
a
,
b
)
->
[
Just
a
,
b
])
$
Map
.
toList
dico
cs'
<-
getNodesByNgramsOnlyUser
cId
(
ls'
<>
ls
)
nt
terms
m
<-
getListNgrams
ls
nt
pure
$
toTree
lt
cs'
m
treeData'
::
FlowCmdM
env
ServerError
m
=>
CorpusId
->
NgramsType
->
ListType
->
m
[
MyTree
]
treeData'
cId
nt
lt
=
do
ls'
<-
selectNodesWithUsername
NodeList
userMaster
ls
<-
map
(
_node_id
)
<$>
getListsWithParentId
cId
ts
<-
mapTermListRoot
ls
nt
<$>
getRepo
let
dico
=
filterListWithRoot
lt
ts
terms
=
catMaybes
$
List
.
concat
$
map
(
\
(
a
,
b
)
->
[
Just
a
,
b
])
$
Map
.
toList
dico
cs'
<-
getNodesByNgramsOnlyUser
cId
(
ls'
<>
ls
)
nt
terms
m
<-
getListNgrams
ls
nt
pure
$
toTree
lt
cs'
m
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