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
118
Issues
118
List
Board
Labels
Milestones
Merge Requests
7
Merge Requests
7
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
ab095537
Commit
ab095537
authored
May 24, 2022
by
Przemyslaw Kaminski
Browse files
Options
Browse Files
Download
Plain Diff
Merge branch 'dev' into 97-dev-istex-search
parents
8900b559
81018527
Pipeline
#2842
failed with stage
in 35 minutes and 47 seconds
Changes
33
Pipelines
1
Show whitespace changes
Inline
Side-by-side
Showing
33 changed files
with
317 additions
and
113 deletions
+317
-113
CHANGELOG.md
CHANGELOG.md
+32
-0
CONTRIBUTING.md
CONTRIBUTING.md
+7
-10
Dockerfile-ihaskell
devops/docker/Dockerfile-ihaskell
+48
-0
mvDockerData
devops/docker/bin/mvDockerData
+15
-0
gargantext.cabal
gargantext.cabal
+3
-1
pkgs.nix
nix/pkgs.nix
+1
-0
package.yaml
package.yaml
+2
-1
GraphQL.hs
src/Gargantext/API/GraphQL.hs
+12
-9
Annuaire.hs
src/Gargantext/API/GraphQL/Annuaire.hs
+75
-0
TreeFirstLevel.hs
src/Gargantext/API/GraphQL/TreeFirstLevel.hs
+44
-16
UserInfo.hs
src/Gargantext/API/GraphQL/UserInfo.hs
+1
-2
Utils.hs
src/Gargantext/API/GraphQL/Utils.hs
+3
-3
Ngrams.hs
src/Gargantext/API/Ngrams.hs
+1
-1
Tools.hs
src/Gargantext/API/Ngrams/Tools.hs
+14
-12
Node.hs
src/Gargantext/API/Node.hs
+5
-6
Export.hs
src/Gargantext/API/Node/Corpus/Export.hs
+2
-2
New.hs
src/Gargantext/API/Node/Corpus/New.hs
+9
-7
Update.hs
src/Gargantext/API/Node/Update.hs
+5
-3
Date.hs
src/Gargantext/Core/Text/Corpus/Parsers/Date.hs
+3
-0
WOS.hs
src/Gargantext/Core/Text/Corpus/Parsers/WOS.hs
+8
-8
List.hs
src/Gargantext/Core/Text/List.hs
+1
-1
Social.hs
src/Gargantext/Core/Text/List/Social.hs
+1
-1
Main.hs
src/Gargantext/Core/Types/Main.hs
+3
-3
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
Flow.hs
src/Gargantext/Database/Action/Flow.hs
+3
-5
Pairing.hs
src/Gargantext/Database/Action/Flow/Pairing.hs
+3
-2
Metrics.hs
src/Gargantext/Database/Action/Metrics.hs
+2
-2
Node.hs
src/Gargantext/Database/Action/Node.hs
+3
-1
Frame.hs
src/Gargantext/Database/Admin/Types/Hyperdata/Frame.hs
+0
-7
Node.hs
src/Gargantext/Database/Admin/Types/Node.hs
+2
-2
stack.yaml
stack.yaml
+2
-1
No files found.
CHANGELOG.md
View file @
ab095537
## Version 0.0.5.8.9
*
[
COUNTS
]
Chart update when docs are deleted or added
*
[
ERGO
]
Plane navigation improved
*
[
ERGO
]
Mouse misalignemnt fixed
*
[
FIX
]
Date parser WOS
*
[
FIX
]
Node names: List -> Terms
## Version 0.0.5.8.8.2
*
[
FE
]
Fix Contact Page
## Version 0.0.5.8.8.1
*
[
FE
]
Fix regression on Graph Explorer: edges color + confluence filter
## Version 0.0.5.8.8
*
[
FE
]
Fix regression on Graph Explorer for annuaire
*
[
FE
]
Graph Doc Focus
## Version 0.0.5.8.7.2
*
[
BE
]
Docker solution for codebook
## Version 0.0.5.8.7.1
*
[
BE
]
Annuaire pairing, using full first name
## Version 0.0.5.8.7
*
[
FE
]
Graph Explorer Document exploration improvements
## Version 0.0.5.8.6
*
[
FE
]
Plane navigation improvements
## Version 0.0.5.8.5.1
*
[
FRONT
]
FIX CSS Forest
## Version 0.0.5.8.5
## Version 0.0.5.8.5
*
[
FRONT
]
CSS + Design, Graph Toolbar and many things
*
[
FRONT
]
CSS + Design, Graph Toolbar and many things
*
[
BACK
]
Security FIX GQL route
*
[
BACK
]
Security FIX GQL route
...
...
CONTRIBUTING.md
View file @
ab095537
# 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
devops/docker/Dockerfile-ihaskell
0 → 100644
View file @
ab095537
FROM gibiansky/ihaskell
USER 0
# gargantext stuff
RUN apt-get update && \
apt-get install -y libblas-dev \
libbz2-dev \
libcairo2-dev \
libgsl-dev \
liblapack-dev \
liblzma-dev \
libmagic-dev \
libpq-dev \
librust-pangocairo-dev \
lzma-dev \
libzmq3-dev \
pkg-config && \
rm -rf /var/lib/apt/lists/*
# ADD . /home/joyvan/src
# RUN chown -R 1000 /home/joyvan/src
USER 1000
# WORKDIR /home/joyvan/src
# RUN stack install --fast
RUN stack install aeson aeson-lens aeson-pretty array \
blaze-html blaze-markup bytestring \
conduit conduit-extra containers \
deepseq directory duckling \
ekg-core ekg-json exceptions \
fgl filepath formatting \
hashable hsparql http-api-data http-client http-client-tls http-conduit \
ini json-stream lens monad-control monad-logger \
morpheus-graphql morpheus-graphql-app morpheus-graphql-core morpheus-graphql-subscriptions \
mtl natural-transformation opaleye pandoc parallel parsec rdf4h \
postgresql-simple profunctors protolude semigroups \
servant servant-auth servant-auth-swagger servant-server \
tagsoup template-haskell time transformers transformers-base \
tuple unordered-containers uuid vector \
wai wai-app-static wai-cors wai-extra wai-websockets warp wreq \
xml-conduit xml-types yaml zip zlib --fast
#CMD ["jupyter", "notebook", "--ip", "0.0.0.0"]
CMD ["stack", "exec", "jupyter", "--", "notebook", "--ip", "0.0.0.0"]
devops/docker/bin/mvDockerData
0 → 100755
View file @
ab095537
#!/bin/bash
sudo
service docker stop
echo
"{
\"
data-root
\"
:
\"
$1
\"
}"
>
/etc/docker/daemon.json
sudo mkdir
-p
$1
sudo
apt update
&&
sudo
apt
-y
install
rsync
sudo
rsync
-aP
/var/lib/docker/
$1
sudo mv
/var/lib/docker /var/lib/docker.old
sudo
service docker start
gargantext.cabal
View file @
ab095537
...
@@ -5,7 +5,7 @@ cabal-version: 1.12
...
@@ -5,7 +5,7 @@ cabal-version: 1.12
-- see: https://github.com/sol/hpack
-- see: https://github.com/sol/hpack
name: gargantext
name: gargantext
version: 0.0.5.8.
5
version: 0.0.5.8.
9
synopsis: Search, map, share
synopsis: Search, map, share
description: Please see README.md
description: Please see README.md
category: Data
category: Data
...
@@ -107,6 +107,7 @@ library
...
@@ -107,6 +107,7 @@ library
Gargantext.API.EKG
Gargantext.API.EKG
Gargantext.API.Flow
Gargantext.API.Flow
Gargantext.API.GraphQL
Gargantext.API.GraphQL
Gargantext.API.GraphQL.Annuaire
Gargantext.API.GraphQL.AsyncTask
Gargantext.API.GraphQL.AsyncTask
Gargantext.API.GraphQL.IMT
Gargantext.API.GraphQL.IMT
Gargantext.API.GraphQL.Node
Gargantext.API.GraphQL.Node
...
@@ -399,6 +400,7 @@ library
...
@@ -399,6 +400,7 @@ library
, http-media
, http-media
, http-types
, http-types
, hxt
, hxt
, ihaskell
, ini
, ini
, insert-ordered-containers
, insert-ordered-containers
, jose
, jose
...
...
nix/pkgs.nix
View file @
ab095537
...
@@ -9,6 +9,7 @@ rec {
...
@@ -9,6 +9,7 @@ rec {
];
];
nonhsBuildInputs
=
with
pkgs
;
[
nonhsBuildInputs
=
with
pkgs
;
[
bzip2
bzip2
czmq
docker-compose
docker-compose
git
git
gmp
gmp
...
...
package.yaml
View file @
ab095537
...
@@ -6,7 +6,7 @@ name: gargantext
...
@@ -6,7 +6,7 @@ name: gargantext
# | | | +----- Layers * : New versions with API additions
# | | | +----- Layers * : New versions with API additions
# | | | | +--- Layers * : New versions without API breaking changes
# | | | | +--- Layers * : New versions without API breaking changes
# | | | | |
# | | | | |
version
:
'
0.0.5.8.
5
'
version
:
'
0.0.5.8.
9
'
synopsis
:
Search, map, share
synopsis
:
Search, map, share
description
:
Please see README.md
description
:
Please see README.md
category
:
Data
category
:
Data
...
@@ -188,6 +188,7 @@ library:
...
@@ -188,6 +188,7 @@ library:
-
http-media
-
http-media
-
http-types
-
http-types
-
hxt
-
hxt
-
ihaskell
-
ini
-
ini
-
insert-ordered-containers
-
insert-ordered-containers
-
jose
-
jose
...
...
src/Gargantext/API/GraphQL.hs
View file @
ab095537
...
@@ -33,6 +33,7 @@ import Data.Proxy
...
@@ -33,6 +33,7 @@ import Data.Proxy
import
Gargantext.API.Admin.Auth.Types
(
AuthenticatedUser
)
import
Gargantext.API.Admin.Auth.Types
(
AuthenticatedUser
)
import
Gargantext.API.Admin.Orchestrator.Types
(
JobLog
)
import
Gargantext.API.Admin.Orchestrator.Types
(
JobLog
)
import
Gargantext.API.Prelude
(
HasJobEnv
'
)
import
Gargantext.API.Prelude
(
HasJobEnv
'
)
import
qualified
Gargantext.API.GraphQL.Annuaire
as
GQLA
import
qualified
Gargantext.API.GraphQL.AsyncTask
as
GQLAT
import
qualified
Gargantext.API.GraphQL.AsyncTask
as
GQLAT
import
qualified
Gargantext.API.GraphQL.IMT
as
GQLIMT
import
qualified
Gargantext.API.GraphQL.IMT
as
GQLIMT
import
qualified
Gargantext.API.GraphQL.Node
as
GQLNode
import
qualified
Gargantext.API.GraphQL.Node
as
GQLNode
...
@@ -64,13 +65,14 @@ import Gargantext.API.Admin.Types (HasSettings)
...
@@ -64,13 +65,14 @@ import Gargantext.API.Admin.Types (HasSettings)
-- | Represents possible GraphQL queries.
-- | Represents possible GraphQL queries.
data
Query
m
data
Query
m
=
Query
=
Query
{
imt_schools
::
GQLIMT
.
SchoolsArgs
->
m
[
GQLIMT
.
School
]
{
annuaire_contacts
::
GQLA
.
AnnuaireContactArgs
->
m
[
GQLA
.
AnnuaireContact
]
,
imt_schools
::
GQLIMT
.
SchoolsArgs
->
m
[
GQLIMT
.
School
]
,
job_logs
::
GQLAT
.
JobLogArgs
->
m
(
Map
Int
JobLog
)
,
job_logs
::
GQLAT
.
JobLogArgs
->
m
(
Map
Int
JobLog
)
,
nodes
::
GQLNode
.
NodeArgs
->
m
[
GQLNode
.
Node
]
,
nodes
::
GQLNode
.
NodeArgs
->
m
[
GQLNode
.
Node
]
,
node_parent
::
GQLNode
.
NodeParentArgs
->
m
[
GQLNode
.
Node
]
,
node_parent
::
GQLNode
.
NodeParentArgs
->
m
[
GQLNode
.
Node
]
,
user_infos
::
GQLUserInfo
.
UserInfoArgs
->
m
[
GQLUserInfo
.
UserInfo
]
,
user_infos
::
GQLUserInfo
.
UserInfoArgs
->
m
[
GQLUserInfo
.
UserInfo
]
,
users
::
GQLUser
.
UserArgs
->
m
[
GQLUser
.
User
m
]
,
users
::
GQLUser
.
UserArgs
->
m
[
GQLUser
.
User
m
]
,
tree
::
GQLTree
.
TreeArgs
->
m
GQLTree
.
TreeFirstLevel
,
tree
::
GQLTree
.
TreeArgs
->
m
(
GQLTree
.
TreeFirstLevel
m
)
}
deriving
(
Generic
,
GQLType
)
}
deriving
(
Generic
,
GQLType
)
data
Mutation
m
data
Mutation
m
...
@@ -100,7 +102,8 @@ rootResolver
...
@@ -100,7 +102,8 @@ rootResolver
=>
RootResolver
(
GargM
env
GargError
)
e
Query
Mutation
Undefined
=>
RootResolver
(
GargM
env
GargError
)
e
Query
Mutation
Undefined
rootResolver
=
rootResolver
=
RootResolver
RootResolver
{
queryResolver
=
Query
{
imt_schools
=
GQLIMT
.
resolveSchools
{
queryResolver
=
Query
{
annuaire_contacts
=
GQLA
.
resolveAnnuaireContacts
,
imt_schools
=
GQLIMT
.
resolveSchools
,
job_logs
=
GQLAT
.
resolveJobLogs
,
job_logs
=
GQLAT
.
resolveJobLogs
,
nodes
=
GQLNode
.
resolveNodes
,
nodes
=
GQLNode
.
resolveNodes
,
node_parent
=
GQLNode
.
resolveNodeParent
,
node_parent
=
GQLNode
.
resolveNodeParent
...
...
src/Gargantext/API/GraphQL/Annuaire.hs
0 → 100644
View file @
ab095537
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DuplicateRecordFields #-}
module
Gargantext.API.GraphQL.Annuaire
where
import
Control.Lens
import
Data.Morpheus.Types
(
GQLType
,
Resolver
,
QUERY
,
lift
)
import
Data.Proxy
import
Data.Text
(
Text
)
import
Gargantext.API.Prelude
(
GargM
,
GargError
)
import
Gargantext.Core.Mail.Types
(
HasMail
)
import
Gargantext.Database.Admin.Types.Hyperdata.Contact
(
HyperdataContact
,
ContactWho
,
cw_firstName
,
cw_lastName
,
hc_who
)
import
Gargantext.Database.Admin.Types.Node
(
NodeId
(
..
))
import
Gargantext.Database.Prelude
(
HasConnectionPool
,
HasConfig
)
import
Gargantext.Database.Query.Table.Context
(
getContextWith
)
import
Gargantext.Database.Schema.Node
(
node_hyperdata
)
import
Gargantext.Prelude
import
GHC.Generics
(
Generic
)
data
AnnuaireContact
=
AnnuaireContact
{
ac_id
::
Int
,
ac_firstName
::
Maybe
Text
,
ac_lastName
::
Maybe
Text
}
deriving
(
Generic
,
GQLType
,
Show
)
-- | Arguments to the "user info" query.
data
AnnuaireContactArgs
=
AnnuaireContactArgs
{
contact_id
::
Int
}
deriving
(
Generic
,
GQLType
)
type
GqlM
e
env
=
Resolver
QUERY
e
(
GargM
env
GargError
)
-- | Function to resolve user from a query.
resolveAnnuaireContacts
::
(
HasConnectionPool
env
,
HasConfig
env
,
HasMail
env
)
=>
AnnuaireContactArgs
->
GqlM
e
env
[
AnnuaireContact
]
resolveAnnuaireContacts
AnnuaireContactArgs
{
contact_id
}
=
dbAnnuaireContacts
contact_id
-- | Inner function to fetch the user from DB.
dbAnnuaireContacts
::
(
HasConnectionPool
env
,
HasConfig
env
,
HasMail
env
)
=>
Int
->
GqlM
e
env
[
AnnuaireContact
]
dbAnnuaireContacts
contact_id
=
do
-- lift $ printDebug "[dbUsers]" user_id
-- user <- getUsersWithId user_id
-- hyperdata <- getUserHyperdata user_id
-- lift (map toUser <$> zip user hyperdata)
c
<-
lift
$
getContextWith
(
NodeId
contact_id
)
(
Proxy
::
Proxy
HyperdataContact
)
pure
[
toAnnuaireContact
(
contact_id
,
c
^.
node_hyperdata
)]
toAnnuaireContact
::
(
Int
,
HyperdataContact
)
->
AnnuaireContact
toAnnuaireContact
(
c_id
,
c_hyperdata
)
=
AnnuaireContact
{
ac_id
=
c_id
,
ac_firstName
=
c_hyperdata
^.
ac_firstNameL
,
ac_lastName
=
c_hyperdata
^.
ac_lastNameL
}
contactWhoL
::
Traversal'
HyperdataContact
ContactWho
contactWhoL
=
hc_who
.
_Just
ac_firstNameL
::
Traversal'
HyperdataContact
(
Maybe
Text
)
ac_firstNameL
=
contactWhoL
.
cw_firstName
ac_lastNameL
::
Traversal'
HyperdataContact
(
Maybe
Text
)
ac_lastNameL
=
contactWhoL
.
cw_lastName
src/Gargantext/API/GraphQL/TreeFirstLevel.hs
View file @
ab095537
...
@@ -11,10 +11,15 @@ import Gargantext.API.Prelude (GargM, GargError)
...
@@ -11,10 +11,15 @@ import Gargantext.API.Prelude (GargM, GargError)
import
Gargantext.Database.Prelude
(
HasConnectionPool
,
HasConfig
)
import
Gargantext.Database.Prelude
(
HasConnectionPool
,
HasConfig
)
import
Gargantext.Core.Mail.Types
(
HasMail
)
import
Gargantext.Core.Mail.Types
(
HasMail
)
import
qualified
Gargantext.Database.Query.Tree
as
T
import
qualified
Gargantext.Database.Query.Tree
as
T
import
qualified
Gargantext.Database.Schema.Node
as
N
import
qualified
Gargantext.Database.Admin.Types.Node
as
NN
import
Gargantext.Database.Admin.Types.Node
(
allNodeTypes
,
NodeId
(
NodeId
))
import
Gargantext.Database.Admin.Types.Node
(
allNodeTypes
,
NodeId
(
NodeId
))
import
Gargantext.Core.Types
(
Tree
,
NodeTree
,
NodeType
)
import
Gargantext.Core.Types
(
Tree
,
NodeTree
,
NodeType
)
import
Gargantext.Core.Types.Main
import
Gargantext.Core.Types.Main
(
Tree
(
TreeN
),
_tn_node
,
_tn_children
,
NodeTree
(
NodeTree
,
_nt_id
,
_nt_type
),
_nt_name
)
(
Tree
(
TreeN
),
_tn_node
,
_tn_children
,
NodeTree
(
NodeTree
,
_nt_id
,
_nt_type
),
_nt_name
)
import
Gargantext.Database.Query.Table.Node
(
getNode
)
import
Gargantext.Database.Admin.Config
(
fromNodeTypeId
)
import
Gargantext.Database.Schema.Node
(
NodePoly
(
_node_parent_id
))
data
TreeArgs
=
TreeArgs
data
TreeArgs
=
TreeArgs
{
{
...
@@ -26,37 +31,60 @@ data TreeNode = TreeNode
...
@@ -26,37 +31,60 @@ data TreeNode = TreeNode
name
::
Text
name
::
Text
,
id
::
Int
,
id
::
Int
,
node_type
::
NodeType
,
node_type
::
NodeType
,
parent_id
::
Maybe
Int
}
deriving
(
Generic
,
GQLType
)
}
deriving
(
Generic
,
GQLType
)
data
TreeFirstLevel
=
TreeFirstLevel
data
TreeFirstLevel
m
=
TreeFirstLevel
{
{
root
::
TreeNode
root
::
TreeNode
,
parent
::
Maybe
TreeNode
,
parent
::
m
(
Maybe
TreeNode
)
,
children
::
[
TreeNode
]
,
children
::
[
TreeNode
]
}
deriving
(
Generic
,
GQLType
)
}
deriving
(
Generic
,
GQLType
)
type
GqlM
e
env
=
Resolver
QUERY
e
(
GargM
env
GargError
)
type
GqlM
e
env
=
Resolver
QUERY
e
(
GargM
env
GargError
)
resolveTree
::
(
HasConnectionPool
env
,
HasConfig
env
,
HasMail
env
)
=>
TreeArgs
->
GqlM
e
env
TreeFirstLevel
type
ParentId
=
Maybe
NodeId
resolveTree
::
(
HasConnectionPool
env
,
HasConfig
env
,
HasMail
env
)
=>
TreeArgs
->
GqlM
e
env
(
TreeFirstLevel
(
GqlM
e
env
))
resolveTree
TreeArgs
{
root_id
}
=
dbTree
root_id
resolveTree
TreeArgs
{
root_id
}
=
dbTree
root_id
dbTree
::
(
HasConnectionPool
env
,
HasConfig
env
,
HasMail
env
)
=>
Int
->
GqlM
e
env
TreeFirstLevel
dbTree
::
(
HasConnectionPool
env
,
HasConfig
env
,
HasMail
env
)
=>
Int
->
GqlM
e
env
(
TreeFirstLevel
(
GqlM
e
env
))
dbTree
root_id
=
do
dbTree
root_id
=
do
t
<-
lift
$
T
.
tree
T
.
TreeFirstLevel
(
NodeId
root_id
)
allNodeTypes
let
rId
=
NodeId
root_id
pure
$
toTree
t
t
<-
lift
$
T
.
tree
T
.
TreeFirstLevel
rId
allNodeTypes
n
<-
lift
$
getNode
$
NodeId
root_id
toTree
::
Tree
NodeTree
->
TreeFirstLevel
let
pId
=
toParentId
n
toTree
TreeN
{
_tn_node
,
_tn_children
}
=
TreeFirstLevel
pure
$
toTree
rId
pId
t
{
parent
=
Nothing
-- TODO
where
,
root
=
toTreeNode
_tn_node
toParentId
N
.
Node
{
_node_parent_id
}
=
_node_parent_id
,
children
=
map
childrenToTreeNodes
_tn_children
toTree
::
(
HasConnectionPool
env
,
HasConfig
env
,
HasMail
env
)
=>
NodeId
->
ParentId
->
Tree
NodeTree
->
TreeFirstLevel
(
GqlM
e
env
)
toTree
rId
pId
TreeN
{
_tn_node
,
_tn_children
}
=
TreeFirstLevel
{
parent
=
resolveParent
pId
,
root
=
toTreeNode
pId
_tn_node
,
children
=
map
childrenToTreeNodes
$
zip
_tn_children
$
repeat
rId
}
}
toTreeNode
::
NodeTree
->
TreeNode
toTreeNode
::
ParentId
->
NodeTree
->
TreeNode
toTreeNode
NodeTree
{
_nt_name
,
_nt_id
,
_nt_type
}
=
TreeNode
{
name
=
_nt_name
,
id
=
id2int
_nt_id
,
node_type
=
_nt_type
}
toTreeNode
pId
NodeTree
{
_nt_name
,
_nt_id
,
_nt_type
}
=
TreeNode
{
name
=
_nt_name
,
id
=
id2int
_nt_id
,
node_type
=
_nt_type
,
parent_id
=
id2int
<$>
pId
}
where
where
id2int
::
NodeId
->
Int
id2int
::
NodeId
->
Int
id2int
(
NodeId
n
)
=
n
id2int
(
NodeId
n
)
=
n
childrenToTreeNodes
::
Tree
NodeTree
->
TreeNode
childrenToTreeNodes
::
(
Tree
NodeTree
,
NodeId
)
->
TreeNode
childrenToTreeNodes
TreeN
{
_tn_node
}
=
toTreeNode
_tn_node
childrenToTreeNodes
(
TreeN
{
_tn_node
},
rId
)
=
toTreeNode
(
Just
rId
)
_tn_node
resolveParent
::
(
HasConnectionPool
env
,
HasConfig
env
,
HasMail
env
)
=>
Maybe
NodeId
->
GqlM
e
env
(
Maybe
TreeNode
)
resolveParent
(
Just
pId
)
=
do
node
<-
lift
$
getNode
pId
pure
$
Just
$
nodeToTreeNode
node
resolveParent
Nothing
=
pure
Nothing
nodeToTreeNode
::
NN
.
Node
json
->
TreeNode
nodeToTreeNode
N
.
Node
{
..
}
=
TreeNode
{
id
=
NN
.
unNodeId
_node_id
,
name
=
_node_name
,
node_type
=
fromNodeTypeId
_node_typename
,
parent_id
=
NN
.
unNodeId
<$>
_node_parent_id
}
src/Gargantext/API/GraphQL/UserInfo.hs
View file @
ab095537
...
@@ -47,7 +47,6 @@ import Gargantext.Prelude
...
@@ -47,7 +47,6 @@ import Gargantext.Prelude
import
GHC.Generics
(
Generic
)
import
GHC.Generics
(
Generic
)
import
Gargantext.API.GraphQL.Utils
(
AuthStatus
(
Invalid
,
Valid
),
authUser
)
import
Gargantext.API.GraphQL.Utils
(
AuthStatus
(
Invalid
,
Valid
),
authUser
)
import
Gargantext.API.Admin.Types
(
HasSettings
)
import
Gargantext.API.Admin.Types
(
HasSettings
)
import
Gargantext.Database.Admin.Types.Node
(
unNodeId
)
data
UserInfo
=
UserInfo
data
UserInfo
=
UserInfo
{
ui_id
::
Int
{
ui_id
::
Int
...
@@ -152,7 +151,7 @@ updateUserInfo (UserInfoMArgs { ui_id, .. }) = do
...
@@ -152,7 +151,7 @@ updateUserInfo (UserInfoMArgs { ui_id, .. }) = do
uh
lens'
(
Just
val
)
u_hyperdata
=
u_hyperdata
&
lens'
.~
Just
val
uh
lens'
(
Just
val
)
u_hyperdata
=
u_hyperdata
&
lens'
.~
Just
val
uh'
_
Nothing
u_hyperdata
=
u_hyperdata
uh'
_
Nothing
u_hyperdata
=
u_hyperdata
uh'
lens'
(
Just
val
)
u_hyperdata
=
u_hyperdata
&
lens'
.~
val
uh'
lens'
(
Just
val
)
u_hyperdata
=
u_hyperdata
&
lens'
.~
val
nId
Node
{
_node_id
}
=
unNodeId
_node_id
nId
Node
{
_node_id
}
=
_node_id
-- | Inner function to fetch the user from DB.
-- | Inner function to fetch the user from DB.
dbUsers
dbUsers
...
...
src/Gargantext/API/GraphQL/Utils.hs
View file @
ab095537
...
@@ -22,7 +22,7 @@ import Control.Lens.Getter (view)
...
@@ -22,7 +22,7 @@ import Control.Lens.Getter (view)
import
Gargantext.Database.Prelude
(
Cmd
'
)
import
Gargantext.Database.Prelude
(
Cmd
'
)
import
Gargantext.API.Admin.Auth.Types
(
AuthenticatedUser
(
AuthenticatedUser
,
_authUser_id
))
import
Gargantext.API.Admin.Auth.Types
(
AuthenticatedUser
(
AuthenticatedUser
,
_authUser_id
))
import
Data.ByteString
(
ByteString
)
import
Data.ByteString
(
ByteString
)
import
Gargantext.Database.Admin.Types.Node
(
un
NodeId
)
import
Gargantext.Database.Admin.Types.Node
(
NodeId
)
unPrefix
::
T
.
Text
->
GQLTypeOptions
->
GQLTypeOptions
unPrefix
::
T
.
Text
->
GQLTypeOptions
->
GQLTypeOptions
unPrefix
prefix
options
=
options
{
fieldLabelModifier
=
nflm
}
unPrefix
prefix
options
=
options
{
fieldLabelModifier
=
nflm
}
...
@@ -31,7 +31,7 @@ unPrefix prefix options = options { fieldLabelModifier = nflm }
...
@@ -31,7 +31,7 @@ unPrefix prefix options = options { fieldLabelModifier = nflm }
data
AuthStatus
=
Valid
|
Invalid
data
AuthStatus
=
Valid
|
Invalid
authUser
::
(
HasSettings
env
)
=>
Int
->
Text
->
Cmd'
env
err
AuthStatus
authUser
::
(
HasSettings
env
)
=>
NodeId
->
Text
->
Cmd'
env
err
AuthStatus
authUser
ui_id
token
=
do
authUser
ui_id
token
=
do
let
token'
=
encodeUtf8
token
let
token'
=
encodeUtf8
token
jwtS
<-
view
$
settings
.
jwtSettings
jwtS
<-
view
$
settings
.
jwtSettings
...
@@ -43,7 +43,7 @@ authUser ui_id token = do
...
@@ -43,7 +43,7 @@ authUser ui_id token = do
then
pure
Valid
then
pure
Valid
else
pure
Invalid
else
pure
Invalid
where
where
nId
AuthenticatedUser
{
_authUser_id
}
=
unNodeId
_authUser_id
nId
AuthenticatedUser
{
_authUser_id
}
=
_authUser_id
getUserFromToken
::
JWTSettings
->
ByteString
->
IO
(
Maybe
AuthenticatedUser
)
getUserFromToken
::
JWTSettings
->
ByteString
->
IO
(
Maybe
AuthenticatedUser
)
getUserFromToken
=
verifyJWT
getUserFromToken
=
verifyJWT
src/Gargantext/API/Ngrams.hs
View file @
ab095537
...
@@ -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 @
ab095537
...
@@ -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.hs
View file @
ab095537
...
@@ -21,8 +21,6 @@ Node API
...
@@ -21,8 +21,6 @@ Node API
-}
-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE TypeOperators #-}
...
@@ -264,10 +262,11 @@ instance ToJSON NodesToCategory
...
@@ -264,10 +262,11 @@ instance ToJSON NodesToCategory
instance
ToSchema
NodesToCategory
instance
ToSchema
NodesToCategory
catApi
::
CorpusId
->
GargServer
CatApi
catApi
::
CorpusId
->
GargServer
CatApi
catApi
=
putCat
catApi
cId
cs'
=
do
where
ret
<-
nodeContextsCategory
$
map
(
\
n
->
(
cId
,
n
,
ntc_category
cs'
))
(
ntc_nodesId
cs'
)
putCat
::
CorpusId
->
NodesToCategory
->
Cmd
err
[
Int
]
lId
<-
defaultList
cId
putCat
cId
cs'
=
nodeContextsCategory
$
map
(
\
n
->
(
cId
,
n
,
ntc_category
cs'
))
(
ntc_nodesId
cs'
)
_
<-
updateChart
cId
(
Just
lId
)
Docs
Nothing
pure
ret
------------------------------------------------------------------------
------------------------------------------------------------------------
type
ScoreApi
=
Summary
" To Score NodeNodes"
type
ScoreApi
=
Summary
" To Score NodeNodes"
...
...
src/Gargantext/API/Node/Corpus/Export.hs
View file @
ab095537
...
@@ -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/API/Node/Corpus/New.hs
View file @
ab095537
...
@@ -220,7 +220,7 @@ addToCorpusWithQuery user cid (WithQuery { _wq_query = q
...
@@ -220,7 +220,7 @@ addToCorpusWithQuery user cid (WithQuery { _wq_query = q
eTxts
<-
mapM
(
\
db
->
getDataText
db
(
Multi
l
)
q
maybeLimit
)
[
database2origin
dbs
]
eTxts
<-
mapM
(
\
db
->
getDataText
db
(
Multi
l
)
q
maybeLimit
)
[
database2origin
dbs
]
let
lTxts
=
lefts
eTxts
let
lTxts
=
lefts
eTxts
printDebug
"[G.A.N.C.New]
e
Txts"
lTxts
printDebug
"[G.A.N.C.New]
l
Txts"
lTxts
case
lTxts
of
case
lTxts
of
[]
->
do
[]
->
do
let
txts
=
rights
eTxts
let
txts
=
rights
eTxts
...
@@ -245,12 +245,14 @@ addToCorpusWithQuery user cid (WithQuery { _wq_query = q
...
@@ -245,12 +245,14 @@ addToCorpusWithQuery user cid (WithQuery { _wq_query = q
(
err
:
_
)
->
do
(
err
:
_
)
->
do
printDebug
"Error: "
err
printDebug
"Error: "
err
pure
$
addEvent
"ERROR"
(
T
.
pack
$
show
err
)
$
let
jl
=
addEvent
"ERROR"
(
T
.
pack
$
show
err
)
$
JobLog
{
_scst_succeeded
=
Just
2
JobLog
{
_scst_succeeded
=
Just
2
,
_scst_failed
=
Just
1
,
_scst_failed
=
Just
1
,
_scst_remaining
=
Just
0
,
_scst_remaining
=
Just
0
,
_scst_events
=
Just
[]
,
_scst_events
=
Just
[]
}
}
logStatus
jl
pure
jl
type
AddWithForm
=
Summary
"Add with FormUrlEncoded to corpus endpoint"
type
AddWithForm
=
Summary
"Add with FormUrlEncoded to corpus endpoint"
...
...
src/Gargantext/API/Node/Update.hs
View file @
ab095537
...
@@ -24,6 +24,7 @@ import GHC.Generics (Generic)
...
@@ -24,6 +24,7 @@ import GHC.Generics (Generic)
import
Gargantext.API.Admin.Orchestrator.Types
(
JobLog
(
..
),
AsyncJobs
)
import
Gargantext.API.Admin.Orchestrator.Types
(
JobLog
(
..
),
AsyncJobs
)
import
Gargantext.API.Admin.Types
(
HasSettings
)
import
Gargantext.API.Admin.Types
(
HasSettings
)
import
Gargantext.API.Ngrams.List
(
reIndexWith
)
import
Gargantext.API.Ngrams.List
(
reIndexWith
)
--import Gargantext.API.Ngrams.Types (TabType(..))
import
Gargantext.API.Prelude
(
GargServer
,
simuLogs
)
import
Gargantext.API.Prelude
(
GargServer
,
simuLogs
)
import
Gargantext.Core.Methods.Distances
(
GraphMetric
(
..
))
import
Gargantext.Core.Methods.Distances
(
GraphMetric
(
..
))
import
Gargantext.Core.Types.Main
(
ListType
(
..
))
import
Gargantext.Core.Types.Main
(
ListType
(
..
))
...
@@ -153,9 +154,9 @@ updateNode _uId lId (UpdateNodeParamsList Advanced) logStatus = do
...
@@ -153,9 +154,9 @@ updateNode _uId lId (UpdateNodeParamsList Advanced) logStatus = do
_
<-
case
corpusId
of
_
<-
case
corpusId
of
Just
cId
->
do
Just
cId
->
do
_
<-
Metrics
.
updatePie
'
cId
(
Just
lId
)
NgramsTypes
.
Authors
Nothing
_
<-
Metrics
.
updatePie
cId
(
Just
lId
)
NgramsTypes
.
Authors
Nothing
_
<-
Metrics
.
updateTree
'
cId
(
Just
lId
)
NgramsTypes
.
Institutes
MapTerm
_
<-
Metrics
.
updateTree
cId
(
Just
lId
)
NgramsTypes
.
Institutes
MapTerm
_
<-
Metrics
.
updatePie
'
cId
(
Just
lId
)
NgramsTypes
.
Sources
Nothing
_
<-
Metrics
.
updatePie
cId
(
Just
lId
)
NgramsTypes
.
Sources
Nothing
pure
()
pure
()
Nothing
->
pure
()
Nothing
->
pure
()
...
@@ -240,6 +241,7 @@ updateNode _uId tId (UpdateNodeParamsTexts _mode) logStatus = do
...
@@ -240,6 +241,7 @@ updateNode _uId tId (UpdateNodeParamsTexts _mode) logStatus = do
_
<-
reIndexWith
cId
lId
NgramsTerms
(
Set
.
singleton
MapTerm
)
_
<-
reIndexWith
cId
lId
NgramsTerms
(
Set
.
singleton
MapTerm
)
_
<-
updateNgramsOccurrences
cId
(
Just
lId
)
_
<-
updateNgramsOccurrences
cId
(
Just
lId
)
_
<-
updateContextScore
cId
(
Just
lId
)
_
<-
updateContextScore
cId
(
Just
lId
)
_
<-
Metrics
.
updateChart
cId
(
Just
lId
)
NgramsTypes
.
Docs
Nothing
-- printDebug "updateContextsScore" (cId, lId, u)
-- printDebug "updateContextsScore" (cId, lId, u)
pure
()
pure
()
Nothing
->
pure
()
Nothing
->
pure
()
...
...
src/Gargantext/Core/Text/Corpus/Parsers/Date.hs
View file @
ab095537
...
@@ -107,6 +107,9 @@ dateFlow (DucklingFailure txt) = case readDate $ replace " " "T" txt of
...
@@ -107,6 +107,9 @@ dateFlow (DucklingFailure txt) = case readDate $ replace " " "T" txt of
Nothing
->
dateFlow
(
ReadFailure1
txt
)
Nothing
->
dateFlow
(
ReadFailure1
txt
)
Just
ok
->
DateFlowSuccess
ok
Just
ok
->
DateFlowSuccess
ok
dateFlow
(
ReadFailure1
txt
)
=
case
readDate
txt
of
dateFlow
(
ReadFailure1
txt
)
=
case
readDate
txt
of
Nothing
->
dateFlow
$
ReadFailure2
txt
Just
ok
->
DateFlowSuccess
ok
dateFlow
(
ReadFailure2
txt
)
=
case
readDate
$
replace
" "
""
txt
<>
"-01-01T00:00:00"
of
Nothing
->
DateFlowFailure
Nothing
->
DateFlowFailure
Just
ok
->
DateFlowSuccess
ok
Just
ok
->
DateFlowSuccess
ok
dateFlow
_
=
DateFlowFailure
dateFlow
_
=
DateFlowFailure
...
...
src/Gargantext/Core/Text/Corpus/Parsers/WOS.hs
View file @
ab095537
...
@@ -47,11 +47,11 @@ notice = start *> many (fieldWith field) <* end
...
@@ -47,11 +47,11 @@ notice = start *> many (fieldWith field) <* end
keys
::
ByteString
->
ByteString
keys
::
ByteString
->
ByteString
keys
champs
keys
field
|
champs
==
"AF"
=
"authors"
|
field
==
"AF"
=
"authors"
|
champs
==
"TI"
=
"title"
|
field
==
"TI"
=
"title"
|
champs
==
"SO"
=
"source"
|
field
==
"SO"
=
"source"
|
champs
==
"DI"
=
"doi"
|
field
==
"DI"
=
"doi"
|
champs
==
"PD
"
=
"publication_date"
|
field
==
"PY
"
=
"publication_date"
|
champs
==
"AB"
=
"abstract"
|
field
==
"AB"
=
"abstract"
|
otherwise
=
champs
|
otherwise
=
field
src/Gargantext/Core/Text/List.hs
View file @
ab095537
...
@@ -124,7 +124,7 @@ buildNgramsOthersList user uCid mfslw _groupParams (nt, MapListSize mapListSize,
...
@@ -124,7 +124,7 @@ buildNgramsOthersList user uCid mfslw _groupParams (nt, MapListSize mapListSize,
$
HashMap
.
toList
tailTerms'
$
HashMap
.
toList
tailTerms'
pure
$
Map
.
fromList
[(
nt
,
(
toNgramsElement
stopTerms
)
pure
$
Map
.
fromList
[(
nt
,
List
.
take
maxListSize
$
(
toNgramsElement
stopTerms
)
<>
(
toNgramsElement
mapTerms
)
<>
(
toNgramsElement
mapTerms
)
<>
(
toNgramsElement
$
setListType
(
Just
MapTerm
)
mapTerms'
)
<>
(
toNgramsElement
$
setListType
(
Just
MapTerm
)
mapTerms'
)
<>
(
toNgramsElement
$
setListType
(
Just
CandidateTerm
)
candiTerms
)
<>
(
toNgramsElement
$
setListType
(
Just
CandidateTerm
)
candiTerms
)
...
...
src/Gargantext/Core/Text/List/Social.hs
View file @
ab095537
...
@@ -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/Types/Main.hs
View file @
ab095537
src/Gargantext/Core/Viz/Chart.hs
View file @
ab095537
...
@@ -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 @
ab095537
...
@@ -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 @
ab095537
...
@@ -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.hs
View file @
ab095537
...
@@ -176,7 +176,6 @@ getDataText_Debug a l q li = do
...
@@ -176,7 +176,6 @@ getDataText_Debug a l q li = do
Right
res
->
liftBase
$
printDataText
res
Right
res
->
liftBase
$
printDataText
res
-------------------------------------------------------------------------------
-------------------------------------------------------------------------------
flowDataText
::
forall
env
err
m
.
flowDataText
::
forall
env
err
m
.
(
FlowCmdM
env
err
m
(
FlowCmdM
env
err
m
...
@@ -258,8 +257,7 @@ flow :: forall env err m a c.
...
@@ -258,8 +257,7 @@ flow :: forall env err m a c.
->
m
CorpusId
->
m
CorpusId
flow
c
u
cn
la
mfslw
(
mLength
,
docsC
)
logStatus
=
do
flow
c
u
cn
la
mfslw
(
mLength
,
docsC
)
logStatus
=
do
-- TODO if public insertMasterDocs else insertUserDocs
-- TODO if public insertMasterDocs else insertUserDocs
ids
<-
runConduit
$
ids
<-
runConduit
$
zipSources
(
yieldMany
[
1
..
])
docsC
zipSources
(
yieldMany
[
1
..
])
docsC
.|
mapMC
insertDoc
.|
mapMC
insertDoc
.|
sinkList
.|
sinkList
-- ids <- traverse (\(idx, doc) -> do
-- ids <- traverse (\(idx, doc) -> do
...
...
src/Gargantext/Database/Action/Flow/Pairing.hs
View file @
ab095537
...
@@ -178,7 +178,8 @@ getNgramsContactId aId = do
...
@@ -178,7 +178,8 @@ getNgramsContactId aId = do
pure
paired
pure
paired
-- POC here, should be a probabilistic function (see the one used to find lang)
-- POC here, should be a probabilistic function (see the one used to find lang)
toName
::
Node
HyperdataContact
->
NgramsTerm
toName
::
Node
HyperdataContact
->
NgramsTerm
toName
contact
=
NgramsTerm
$
(
Text
.
toTitle
$
Text
.
take
1
firstName
)
<>
". "
<>
(
Text
.
toTitle
lastName
)
-- toName contact = NgramsTerm $ (Text.toTitle $ Text.take 1 firstName) <> ". " <> (Text.toTitle lastName)
toName
contact
=
NgramsTerm
$
(
Text
.
toTitle
firstName
)
<>
" "
<>
(
Text
.
toTitle
lastName
)
where
where
firstName
=
fromMaybe
""
$
contact
^.
(
node_hyperdata
.
hc_who
.
_Just
.
cw_firstName
)
firstName
=
fromMaybe
""
$
contact
^.
(
node_hyperdata
.
hc_who
.
_Just
.
cw_firstName
)
lastName
=
fromMaybe
""
$
contact
^.
(
node_hyperdata
.
hc_who
.
_Just
.
cw_lastName
)
lastName
=
fromMaybe
""
$
contact
^.
(
node_hyperdata
.
hc_who
.
_Just
.
cw_lastName
)
...
@@ -189,7 +190,7 @@ getNgramsDocId :: CorpusId
...
@@ -189,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 @
ab095537
...
@@ -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
]]
...
...
src/Gargantext/Database/Action/Node.hs
View file @
ab095537
...
@@ -86,7 +86,9 @@ mkNodeWithParent_ConfigureHyperdata NodeFrameVisio (Just i) uId name =
...
@@ -86,7 +86,9 @@ mkNodeWithParent_ConfigureHyperdata NodeFrameVisio (Just i) uId name =
mkNodeWithParent_ConfigureHyperdata'
NodeFrameVisio
(
Just
i
)
uId
name
mkNodeWithParent_ConfigureHyperdata'
NodeFrameVisio
(
Just
i
)
uId
name
mkNodeWithParent_ConfigureHyperdata
NodeFrameNotebook
(
Just
i
)
uId
name
=
mkNodeWithParent_ConfigureHyperdata
NodeFrameNotebook
(
Just
i
)
uId
name
=
insertNode
NodeFrameNotebook
(
Just
"Notebook"
)
(
Just
$
DefaultFrameCode
$
HyperdataFrame
"Notebook"
name
)
i
uId
insertNode
NodeFrameNotebook
(
Just
"Notebook"
)
(
Just
$
DefaultFrameCode
$
HyperdataFrame
{
_hf_base
=
"Codebook"
,
_hf_frame_id
=
name
})
i
uId
mkNodeWithParent_ConfigureHyperdata
_
_
_
_
=
nodeError
NotImplYet
mkNodeWithParent_ConfigureHyperdata
_
_
_
_
=
nodeError
NotImplYet
...
...
src/Gargantext/Database/Admin/Types/Hyperdata/Frame.hs
View file @
ab095537
...
@@ -9,13 +9,6 @@ Portability : POSIX
...
@@ -9,13 +9,6 @@ Portability : POSIX
-}
-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TemplateHaskell #-}
module
Gargantext.Database.Admin.Types.Hyperdata.Frame
module
Gargantext.Database.Admin.Types.Hyperdata.Frame
...
...
src/Gargantext/Database/Admin/Types/Node.hs
View file @
ab095537
...
@@ -372,7 +372,7 @@ defaultName NodeAnnuaire = "Annuaire"
...
@@ -372,7 +372,7 @@ defaultName NodeAnnuaire = "Annuaire"
defaultName
NodeDocument
=
"Doc"
defaultName
NodeDocument
=
"Doc"
defaultName
NodeTexts
=
"Docs"
defaultName
NodeTexts
=
"Docs"
defaultName
NodeList
=
"
List
"
defaultName
NodeList
=
"
Terms
"
defaultName
NodeListCooc
=
"List"
defaultName
NodeListCooc
=
"List"
defaultName
NodeModel
=
"Model"
defaultName
NodeModel
=
"Model"
...
@@ -386,7 +386,7 @@ defaultName NodeDashboard = "Board"
...
@@ -386,7 +386,7 @@ defaultName NodeDashboard = "Board"
defaultName
NodeGraph
=
"Graph"
defaultName
NodeGraph
=
"Graph"
defaultName
NodePhylo
=
"Phylo"
defaultName
NodePhylo
=
"Phylo"
defaultName
NodeFrameWrite
=
"
Wri
te"
defaultName
NodeFrameWrite
=
"
No
te"
defaultName
NodeFrameCalc
=
"Calc"
defaultName
NodeFrameCalc
=
"Calc"
defaultName
NodeFrameVisio
=
"Visio"
defaultName
NodeFrameVisio
=
"Visio"
defaultName
NodeFrameNotebook
=
"Code"
defaultName
NodeFrameNotebook
=
"Code"
...
...
stack.yaml
View file @
ab095537
...
@@ -5,6 +5,7 @@ extra-package-dbs: []
...
@@ -5,6 +5,7 @@ extra-package-dbs: []
skip-ghc-check
:
true
skip-ghc-check
:
true
packages
:
packages
:
-
.
-
.
#- 'deps/gargantext-graph'
#- 'deps/gargantext-graph'
#- 'deps/haskell-opaleye'
#- 'deps/haskell-opaleye'
...
@@ -73,7 +74,7 @@ extra-deps:
...
@@ -73,7 +74,7 @@ extra-deps:
-
git
:
https://gitlab.iscpif.fr/gargantext/crawlers/istex.git
-
git
:
https://gitlab.iscpif.fr/gargantext/crawlers/istex.git
commit
:
a4a6fb6a578255c9e5b52aab2afccf874976a3f5
commit
:
a4a6fb6a578255c9e5b52aab2afccf874976a3f5
-
git
:
https://gitlab.iscpif.fr/gargantext/crawlers/hal.git
-
git
:
https://gitlab.iscpif.fr/gargantext/crawlers/hal.git
commit
:
3bf77f28d3dc71d2e8349cbf422a34cf4c23cd11
commit
:
9a43470241690a19c1c381c42a62c5dd4e28dff2
-
git
:
https://gitlab.iscpif.fr/gargantext/crawlers/isidore.git
-
git
:
https://gitlab.iscpif.fr/gargantext/crawlers/isidore.git
commit
:
3db385e767d2100d8abe900833c6e7de3ac55e1b
commit
:
3db385e767d2100d8abe900833c6e7de3ac55e1b
-
git
:
https://gitlab.iscpif.fr/gargantext/crawlers/arxiv-api.git
-
git
:
https://gitlab.iscpif.fr/gargantext/crawlers/arxiv-api.git
...
...
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