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
573c8096
Commit
573c8096
authored
May 16, 2022
by
Alexandre Delanoë
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
[TOOLS] repoSize and renaming
parent
13c85c2f
Changes
10
Hide whitespace changes
Inline
Side-by-side
Showing
10 changed files
with
35 additions
and
36 deletions
+35
-36
CONTRIBUTING.md
CONTRIBUTING.md
+7
-10
Ngrams.hs
src/Gargantext/API/Ngrams.hs
+1
-1
Tools.hs
src/Gargantext/API/Ngrams/Tools.hs
+14
-12
Export.hs
src/Gargantext/API/Node/Corpus/Export.hs
+2
-2
Social.hs
src/Gargantext/Core/Text/List/Social.hs
+1
-1
Chart.hs
src/Gargantext/Core/Viz/Chart.hs
+2
-2
API.hs
src/Gargantext/Core/Viz/Graph/API.hs
+3
-3
Tools.hs
src/Gargantext/Core/Viz/Phylo/API/Tools.hs
+2
-2
Pairing.hs
src/Gargantext/Database/Action/Flow/Pairing.hs
+1
-1
Metrics.hs
src/Gargantext/Database/Action/Metrics.hs
+2
-2
No files found.
CONTRIBUTING.md
View file @
573c8096
# Contributing
# Contributing
##
Main repo
##
Code contribution
https://gitlab.iscpif.fr/gargantext/haskell-gargantext
We use Git to share and merge our code.
## Style
## Stack by default
We are using the common Haskell Style:
https://github.com/tibbe/haskell-style-guide/blob/master/haskell-style.md
stack install
## Code Of Conduct
## REPL
stack ghci at the root of the project (it will load right paths of
static resources).
Be constructive as sharing our code of conduct
src/Gargantext/API/Ngrams.hs
View file @
573c8096
...
@@ -261,7 +261,7 @@ setListNgrams listId ngramsType ns = do
...
@@ -261,7 +261,7 @@ setListNgrams listId ngramsType ns = do
currentVersion
::
HasNodeStory
env
err
m
currentVersion
::
HasNodeStory
env
err
m
=>
ListId
->
m
Version
=>
ListId
->
m
Version
currentVersion
listId
=
do
currentVersion
listId
=
do
nls
<-
getRepo
'
[
listId
]
nls
<-
getRepo
[
listId
]
pure
$
nls
^.
unNodeStory
.
at
listId
.
_Just
.
a_version
pure
$
nls
^.
unNodeStory
.
at
listId
.
_Just
.
a_version
...
...
src/Gargantext/API/Ngrams/Tools.hs
View file @
573c8096
...
@@ -35,22 +35,26 @@ mergeNgramsElement _neOld neNew = neNew
...
@@ -35,22 +35,26 @@ mergeNgramsElement _neOld neNew = neNew
type
RootTerm
=
NgramsTerm
type
RootTerm
=
NgramsTerm
{-
getRepo :: RepoCmdM env err m => m NgramsRepo
getRepo = do
v <- view repoVar
liftBase $ readMVar v
-}
getRepo
'
::
HasNodeStory
env
err
m
getRepo
::
HasNodeStory
env
err
m
=>
[
ListId
]
->
m
NodeListStory
=>
[
ListId
]
->
m
NodeListStory
getRepo
'
listIds
=
do
getRepo
listIds
=
do
f
<-
getNodeListStory
f
<-
getNodeListStory
v
<-
liftBase
$
f
listIds
v
<-
liftBase
$
f
listIds
v'
<-
liftBase
$
readMVar
v
v'
<-
liftBase
$
readMVar
v
pure
$
v'
pure
$
v'
repoSize
::
Ord
k1
=>
NodeStory
(
Map
.
Map
k1
(
Map
.
Map
k2
a
))
p
->
NodeId
->
Map
.
Map
k1
Int
repoSize
repo
node_id
=
Map
.
map
Map
.
size
state
where
state
=
repo
^.
unNodeStory
.
at
node_id
.
_Just
.
a_state
getNodeStoryVar
::
HasNodeStory
env
err
m
getNodeStoryVar
::
HasNodeStory
env
err
m
=>
[
ListId
]
->
m
(
MVar
NodeListStory
)
=>
[
ListId
]
->
m
(
MVar
NodeListStory
)
getNodeStoryVar
l
=
do
getNodeStoryVar
l
=
do
...
@@ -83,8 +87,6 @@ listNgramsFromRepo nodeIds ngramsType repo =
...
@@ -83,8 +87,6 @@ listNgramsFromRepo nodeIds ngramsType repo =
|
nodeId
<-
nodeIds
|
nodeId
<-
nodeIds
]
]
-- TODO-ACCESS: We want to do the security check before entering here.
-- TODO-ACCESS: We want to do the security check before entering here.
-- Add a static capability parameter would be nice.
-- Add a static capability parameter would be nice.
-- Ideally this is the access to `repoVar` which needs to
-- Ideally this is the access to `repoVar` which needs to
...
@@ -93,7 +95,7 @@ getListNgrams :: HasNodeStory env err m
...
@@ -93,7 +95,7 @@ getListNgrams :: HasNodeStory env err m
=>
[
ListId
]
->
NgramsType
=>
[
ListId
]
->
NgramsType
->
m
(
HashMap
NgramsTerm
NgramsRepoElement
)
->
m
(
HashMap
NgramsTerm
NgramsRepoElement
)
getListNgrams
nodeIds
ngramsType
=
listNgramsFromRepo
nodeIds
ngramsType
getListNgrams
nodeIds
ngramsType
=
listNgramsFromRepo
nodeIds
ngramsType
<$>
getRepo
'
nodeIds
<$>
getRepo
nodeIds
getTermsWith
::
(
HasNodeStory
env
err
m
,
Eq
a
,
Hashable
a
)
getTermsWith
::
(
HasNodeStory
env
err
m
,
Eq
a
,
Hashable
a
)
...
@@ -105,7 +107,7 @@ getTermsWith f ls ngt lts = HM.fromListWith (<>)
...
@@ -105,7 +107,7 @@ getTermsWith f ls ngt lts = HM.fromListWith (<>)
<$>
HM
.
toList
<$>
HM
.
toList
<$>
HM
.
filter
(
\
f'
->
Set
.
member
(
fst
f'
)
lts
)
<$>
HM
.
filter
(
\
f'
->
Set
.
member
(
fst
f'
)
lts
)
<$>
mapTermListRoot
ls
ngt
<$>
mapTermListRoot
ls
ngt
<$>
getRepo
'
ls
<$>
getRepo
ls
where
where
toTreeWith
(
t
,
(
_lt
,
maybeRoot
))
=
case
maybeRoot
of
toTreeWith
(
t
,
(
_lt
,
maybeRoot
))
=
case
maybeRoot
of
Nothing
->
(
f
t
,
[]
)
Nothing
->
(
f
t
,
[]
)
...
...
src/Gargantext/API/Node/Corpus/Export.hs
View file @
573c8096
...
@@ -28,7 +28,7 @@ import qualified Data.HashMap.Strict as HashMap
...
@@ -28,7 +28,7 @@ import qualified Data.HashMap.Strict as HashMap
import
Gargantext.API.Node.Corpus.Export.Types
import
Gargantext.API.Node.Corpus.Export.Types
import
qualified
Gargantext.API.Node.Document.Export.Types
as
DocumentExport
import
qualified
Gargantext.API.Node.Document.Export.Types
as
DocumentExport
import
Gargantext.API.Ngrams.Types
import
Gargantext.API.Ngrams.Types
import
Gargantext.API.Ngrams.Tools
(
filterListWithRoot
,
mapTermListRoot
,
getRepo
'
)
import
Gargantext.API.Ngrams.Tools
(
filterListWithRoot
,
mapTermListRoot
,
getRepo
)
import
Gargantext.API.Prelude
(
GargNoServer
)
import
Gargantext.API.Prelude
(
GargNoServer
)
import
Gargantext.Prelude.Crypto.Hash
(
hash
)
import
Gargantext.Prelude.Crypto.Hash
(
hash
)
import
Gargantext.Core.Types
import
Gargantext.Core.Types
...
@@ -66,7 +66,7 @@ getCorpus cId lId nt' = do
...
@@ -66,7 +66,7 @@ getCorpus cId lId nt' = do
<$>
map
(
\
n
->
(
_context_id
n
,
n
))
<$>
map
(
\
n
->
(
_context_id
n
,
n
))
<$>
selectDocNodes
cId
<$>
selectDocNodes
cId
repo
<-
getRepo
'
[
listId
]
repo
<-
getRepo
[
listId
]
ngs
<-
getContextNgrams
cId
listId
MapTerm
nt
repo
ngs
<-
getContextNgrams
cId
listId
MapTerm
nt
repo
let
-- uniqId is hash computed already for each document imported in database
let
-- uniqId is hash computed already for each document imported in database
r
=
Map
.
intersectionWith
r
=
Map
.
intersectionWith
...
...
src/Gargantext/Core/Text/List/Social.hs
View file @
573c8096
...
@@ -168,5 +168,5 @@ getHistory :: ( HasNodeStory env err m
...
@@ -168,5 +168,5 @@ getHistory :: ( HasNodeStory env err m
->
[
ListId
]
->
[
ListId
]
->
m
(
Map
ListId
(
Map
NgramsType
[
HashMap
NgramsTerm
NgramsPatch
]))
->
m
(
Map
ListId
(
Map
NgramsType
[
HashMap
NgramsTerm
NgramsPatch
]))
getHistory
hist
nt
listes
=
getHistory
hist
nt
listes
=
history
hist
[
nt
]
listes
<$>
getRepo
'
listes
history
hist
[
nt
]
listes
<$>
getRepo
listes
src/Gargantext/Core/Viz/Chart.hs
View file @
573c8096
...
@@ -59,7 +59,7 @@ chartData :: FlowCmdM env err m
...
@@ -59,7 +59,7 @@ chartData :: FlowCmdM env err m
chartData
cId
nt
lt
=
do
chartData
cId
nt
lt
=
do
ls'
<-
selectNodesWithUsername
NodeList
userMaster
ls'
<-
selectNodesWithUsername
NodeList
userMaster
ls
<-
map
(
_node_id
)
<$>
getListsWithParentId
cId
ls
<-
map
(
_node_id
)
<$>
getListsWithParentId
cId
ts
<-
mapTermListRoot
ls
nt
<$>
getRepo
'
ls
ts
<-
mapTermListRoot
ls
nt
<$>
getRepo
ls
let
let
dico
=
filterListWithRoot
[
lt
]
ts
dico
=
filterListWithRoot
[
lt
]
ts
terms
=
catMaybes
$
List
.
concat
$
map
(
\
(
a
,
b
)
->
[
Just
a
,
b
])
$
HashMap
.
toList
dico
terms
=
catMaybes
$
List
.
concat
$
map
(
\
(
a
,
b
)
->
[
Just
a
,
b
])
$
HashMap
.
toList
dico
...
@@ -83,7 +83,7 @@ treeData :: FlowCmdM env err m
...
@@ -83,7 +83,7 @@ treeData :: FlowCmdM env err m
treeData
cId
nt
lt
=
do
treeData
cId
nt
lt
=
do
ls'
<-
selectNodesWithUsername
NodeList
userMaster
ls'
<-
selectNodesWithUsername
NodeList
userMaster
ls
<-
map
(
_node_id
)
<$>
getListsWithParentId
cId
ls
<-
map
(
_node_id
)
<$>
getListsWithParentId
cId
ts
<-
mapTermListRoot
ls
nt
<$>
getRepo
'
ls
ts
<-
mapTermListRoot
ls
nt
<$>
getRepo
ls
let
let
dico
=
filterListWithRoot
[
lt
]
ts
dico
=
filterListWithRoot
[
lt
]
ts
...
...
src/Gargantext/Core/Viz/Graph/API.hs
View file @
573c8096
...
@@ -96,7 +96,7 @@ getGraph _uId nId = do
...
@@ -96,7 +96,7 @@ getGraph _uId nId = do
-- printDebug "[getGraph] getting list for cId" cId
-- printDebug "[getGraph] getting list for cId" cId
listId
<-
defaultList
cId
listId
<-
defaultList
cId
repo
<-
getRepo
'
[
listId
]
repo
<-
getRepo
[
listId
]
-- TODO Distance in Graph params
-- TODO Distance in Graph params
case
graph
of
case
graph
of
...
@@ -142,7 +142,7 @@ recomputeGraph _uId nId method maybeDistance force = do
...
@@ -142,7 +142,7 @@ recomputeGraph _uId nId method maybeDistance force = do
let
cId
=
maybe
(
panic
"[G.V.G.API] Node has no parent"
)
identity
mcId
let
cId
=
maybe
(
panic
"[G.V.G.API] Node has no parent"
)
identity
mcId
listId
<-
defaultList
cId
listId
<-
defaultList
cId
repo
<-
getRepo
'
[
listId
]
repo
<-
getRepo
[
listId
]
let
v
=
repo
^.
unNodeStory
.
at
listId
.
_Just
.
a_version
let
v
=
repo
^.
unNodeStory
.
at
listId
.
_Just
.
a_version
let
computeG
mt
=
do
let
computeG
mt
=
do
...
@@ -286,7 +286,7 @@ graphVersions n nId = do
...
@@ -286,7 +286,7 @@ graphVersions n nId = do
else
panic
"[G.V.G.API] list not found after iterations"
else
panic
"[G.V.G.API] list not found after iterations"
Just
listId
->
do
Just
listId
->
do
repo
<-
getRepo
'
[
listId
]
repo
<-
getRepo
[
listId
]
let
v
=
repo
^.
unNodeStory
.
at
listId
.
_Just
.
a_version
let
v
=
repo
^.
unNodeStory
.
at
listId
.
_Just
.
a_version
-- printDebug "graphVersions" v
-- printDebug "graphVersions" v
...
...
src/Gargantext/Core/Viz/Phylo/API/Tools.hs
View file @
573c8096
...
@@ -21,7 +21,7 @@ import Data.Text (Text, pack)
...
@@ -21,7 +21,7 @@ import Data.Text (Text, pack)
import
Data.Time.Calendar
(
fromGregorian
,
diffGregorianDurationClip
,
cdMonths
,
diffDays
,
showGregorian
)
import
Data.Time.Calendar
(
fromGregorian
,
diffGregorianDurationClip
,
cdMonths
,
diffDays
,
showGregorian
)
import
Data.Time.Clock.POSIX
(
posixSecondsToUTCTime
)
import
Data.Time.Clock.POSIX
(
posixSecondsToUTCTime
)
import
Gargantext.API.Ngrams.Prelude
(
getTermList
)
import
Gargantext.API.Ngrams.Prelude
(
getTermList
)
import
Gargantext.API.Ngrams.Tools
(
getRepo
'
)
import
Gargantext.API.Ngrams.Tools
(
getRepo
)
import
Gargantext.API.Ngrams.Types
(
NgramsTerm
(
..
))
import
Gargantext.API.Ngrams.Types
(
NgramsTerm
(
..
))
import
Gargantext.API.Node.Corpus.Export
(
getContextNgrams
)
import
Gargantext.API.Node.Corpus.Export
(
getContextNgrams
)
import
Gargantext.API.Prelude
(
GargNoServer
)
import
Gargantext.API.Prelude
(
GargNoServer
)
...
@@ -96,7 +96,7 @@ corpusIdtoDocuments :: TimeUnit -> CorpusId -> GargNoServer (TermList, [Document
...
@@ -96,7 +96,7 @@ corpusIdtoDocuments :: TimeUnit -> CorpusId -> GargNoServer (TermList, [Document
corpusIdtoDocuments
timeUnit
corpusId
=
do
corpusIdtoDocuments
timeUnit
corpusId
=
do
docs
<-
selectDocNodes
corpusId
docs
<-
selectDocNodes
corpusId
lId
<-
defaultList
corpusId
lId
<-
defaultList
corpusId
repo
<-
getRepo
'
[
lId
]
repo
<-
getRepo
[
lId
]
ngs_terms
<-
getContextNgrams
corpusId
lId
MapTerm
NgramsTerms
repo
ngs_terms
<-
getContextNgrams
corpusId
lId
MapTerm
NgramsTerms
repo
ngs_sources
<-
getContextNgrams
corpusId
lId
MapTerm
Sources
repo
ngs_sources
<-
getContextNgrams
corpusId
lId
MapTerm
Sources
repo
...
...
src/Gargantext/Database/Action/Flow/Pairing.hs
View file @
573c8096
...
@@ -190,7 +190,7 @@ getNgramsDocId :: CorpusId
...
@@ -190,7 +190,7 @@ getNgramsDocId :: CorpusId
->
GargNoServer
(
HashMap
DocAuthor
(
Set
NodeId
))
->
GargNoServer
(
HashMap
DocAuthor
(
Set
NodeId
))
getNgramsDocId
cId
lId
nt
=
do
getNgramsDocId
cId
lId
nt
=
do
lIds
<-
selectNodesWithUsername
NodeList
userMaster
lIds
<-
selectNodesWithUsername
NodeList
userMaster
repo
<-
getRepo
'
(
lId
:
lIds
)
repo
<-
getRepo
(
lId
:
lIds
)
let
ngs
=
filterListWithRoot
[
MapTerm
,
CandidateTerm
]
$
mapTermListRoot
(
lId
:
lIds
)
nt
repo
let
ngs
=
filterListWithRoot
[
MapTerm
,
CandidateTerm
]
$
mapTermListRoot
(
lId
:
lIds
)
nt
repo
-- printDebug "getNgramsDocId" ngs
-- printDebug "getNgramsDocId" ngs
...
...
src/Gargantext/Database/Action/Metrics.hs
View file @
573c8096
...
@@ -23,7 +23,7 @@ import Database.PostgreSQL.Simple (Query, Only(..))
...
@@ -23,7 +23,7 @@ import Database.PostgreSQL.Simple (Query, Only(..))
import
Database.PostgreSQL.Simple.Types
(
Values
(
..
),
QualifiedIdentifier
(
..
))
import
Database.PostgreSQL.Simple.Types
(
Values
(
..
),
QualifiedIdentifier
(
..
))
import
Data.Vector
(
Vector
)
import
Data.Vector
(
Vector
)
import
Gargantext.Core
(
HasDBid
(
toDBid
))
import
Gargantext.Core
(
HasDBid
(
toDBid
))
import
Gargantext.API.Ngrams.Tools
(
filterListWithRoot
,
groupNodesByNgrams
,
Diagonal
(
..
),
getCoocByNgrams
,
mapTermListRoot
,
RootTerm
,
getRepo
'
)
import
Gargantext.API.Ngrams.Tools
(
filterListWithRoot
,
groupNodesByNgrams
,
Diagonal
(
..
),
getCoocByNgrams
,
mapTermListRoot
,
RootTerm
,
getRepo
)
import
Gargantext.Database.Prelude
(
runPGSQuery
{-, formatPGSQuery-}
)
import
Gargantext.Database.Prelude
(
runPGSQuery
{-, formatPGSQuery-}
)
import
Gargantext.API.Ngrams.Types
(
TabType
(
..
),
ngramsTypeFromTabType
,
NgramsTerm
(
..
))
import
Gargantext.API.Ngrams.Types
(
TabType
(
..
),
ngramsTypeFromTabType
,
NgramsTerm
(
..
))
import
Gargantext.Core.Mail.Types
(
HasMail
)
import
Gargantext.Core.Mail.Types
(
HasMail
)
...
@@ -233,7 +233,7 @@ getNgrams :: (HasMail env, HasNodeStory env err m)
...
@@ -233,7 +233,7 @@ getNgrams :: (HasMail env, HasNodeStory env err m)
)
)
getNgrams
lId
tabType
=
do
getNgrams
lId
tabType
=
do
lists
<-
mapTermListRoot
[
lId
]
(
ngramsTypeFromTabType
tabType
)
<$>
getRepo
'
[
lId
]
lists
<-
mapTermListRoot
[
lId
]
(
ngramsTypeFromTabType
tabType
)
<$>
getRepo
[
lId
]
-- TODO filterListWithRoot [MapTerm, StopTerm, CandidateTerm] lists
-- TODO filterListWithRoot [MapTerm, StopTerm, CandidateTerm] lists
let
maybeSyn
=
HM
.
unions
$
map
(
\
t
->
filterListWithRoot
t
lists
)
let
maybeSyn
=
HM
.
unions
$
map
(
\
t
->
filterListWithRoot
t
lists
)
[[
MapTerm
],
[
StopTerm
],
[
CandidateTerm
]]
[[
MapTerm
],
[
StopTerm
],
[
CandidateTerm
]]
...
...
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