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
197
Issues
197
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
d42d7f26
Commit
d42d7f26
authored
Nov 20, 2021
by
Alexandre Delanoë
Browse files
Options
Browse Files
Download
Plain Diff
Merge branch 'dev' into dev-wikidata
parents
bdb12f4e
0abfe7aa
Pipeline
#2128
failed with stage
in 10 minutes and 35 seconds
Changes
6
Pipelines
1
Show whitespace changes
Inline
Side-by-side
Showing
6 changed files
with
39 additions
and
28 deletions
+39
-28
package.yaml
package.yaml
+1
-1
DocumentUpload.hs
src/Gargantext/API/Node/DocumentUpload.hs
+26
-18
Distances.hs
src/Gargantext/Core/Methods/Distances.hs
+6
-4
Bridgeness.hs
src/Gargantext/Core/Viz/Graph/Bridgeness.hs
+0
-1
Tools.hs
src/Gargantext/Core/Viz/Graph/Tools.hs
+2
-2
Mail.hs
src/Gargantext/Database/Action/Mail.hs
+4
-2
No files found.
package.yaml
View file @
d42d7f26
name
:
gargantext
name
:
gargantext
version
:
'
0.0.4.8.
1
'
version
:
'
0.0.4.8.
2
'
synopsis
:
Search, map, share
synopsis
:
Search, map, share
description
:
Please see README.md
description
:
Please see README.md
category
:
Data
category
:
Data
...
...
src/Gargantext/API/Node/DocumentUpload.hs
View file @
d42d7f26
...
@@ -8,32 +8,35 @@ module Gargantext.API.Node.DocumentUpload where
...
@@ -8,32 +8,35 @@ module Gargantext.API.Node.DocumentUpload where
import
Control.Lens
(
makeLenses
,
view
)
import
Control.Lens
(
makeLenses
,
view
)
import
Data.Aeson
import
Data.Aeson
import
Data.Swagger
(
ToSchema
)
import
Data.Swagger
(
ToSchema
)
import
qualified
Data.Text
as
T
import
Data.Time.Clock
import
Data.Time.Calendar
import
GHC.Generics
(
Generic
)
import
GHC.Generics
(
Generic
)
import
Servant
import
Servant
import
Servant.Job.Async
import
Servant.Job.Async
import
qualified
Data.Text
as
T
import
Gargantext.API.Admin.Orchestrator.Types
(
JobLog
(
..
),
AsyncJobs
)
import
Gargantext.API.Admin.Orchestrator.Types
(
JobLog
(
..
),
AsyncJobs
)
import
Gargantext.API.Job
(
jobLogSuccess
)
import
Gargantext.API.Job
(
jobLogSuccess
)
import
Gargantext.API.Prelude
import
Gargantext.API.Prelude
import
Gargantext.Core
(
Lang
(
..
))
import
Gargantext.Core
(
Lang
(
..
))
import
Gargantext.Core.Text.Terms
(
TermType
(
..
))
import
Gargantext.Core.Text.Corpus.Parsers.Date
(
dateSplit
)
import
Gargantext.Core.Types.Individu
(
User
(
..
))
import
Gargantext.Core.Utils.Prefix
(
unCapitalize
,
dropPrefix
)
import
Gargantext.Core.Utils.Prefix
(
unCapitalize
,
dropPrefix
)
import
Gargantext.Database.Action.Flow
(
flowDataText
,
DataText
(
..
))
import
Gargantext.Database.Action.Flow.Types
import
Gargantext.Database.Action.Flow.Types
import
Gargantext.Core.Text.Terms
(
TermType
(
..
))
import
Gargantext.Database.Action.Flow
(
insertMasterDocs
)
import
Gargantext.Database.Admin.Types.Hyperdata.Document
(
HyperdataDocument
(
..
))
import
Gargantext.Database.Admin.Types.Hyperdata.Document
(
HyperdataDocument
(
..
))
import
qualified
Gargantext.Database.Query.Table.Node.Document.Add
as
Doc
(
add
)
import
Gargantext.Database.Admin.Types.Node
import
Gargantext.Database.Admin.Types.Node
import
Gargantext.Database.Query.Table.Node
(
getClosestParentIdByType'
)
import
Gargantext.Database.Query.Table.Node
(
getClosestParentIdByType'
)
import
Gargantext.Prelude
import
Gargantext.Prelude
import
Gargantext.Database.Admin.Types.Hyperdata.Corpus
(
HyperdataCorpus
(
..
))
data
DocumentUpload
=
DocumentUpload
data
DocumentUpload
=
DocumentUpload
{
_du_abstract
::
T
.
Text
{
_du_abstract
::
T
.
Text
,
_du_authors
::
T
.
Text
,
_du_authors
::
T
.
Text
,
_du_sources
::
T
.
Text
,
_du_sources
::
T
.
Text
,
_du_title
::
T
.
Text
}
,
_du_title
::
T
.
Text
,
_du_date
::
T
.
Text
}
deriving
(
Generic
)
deriving
(
Generic
)
$
(
makeLenses
''
D
ocumentUpload
)
$
(
makeLenses
''
D
ocumentUpload
)
...
@@ -75,7 +78,7 @@ documentUpload :: (FlowCmdM env err m)
...
@@ -75,7 +78,7 @@ documentUpload :: (FlowCmdM env err m)
->
DocumentUpload
->
DocumentUpload
->
(
JobLog
->
m
()
)
->
(
JobLog
->
m
()
)
->
m
JobLog
->
m
JobLog
documentUpload
uId
nId
doc
logStatus
=
do
documentUpload
_
uId
nId
doc
logStatus
=
do
let
jl
=
JobLog
{
_scst_succeeded
=
Just
0
let
jl
=
JobLog
{
_scst_succeeded
=
Just
0
,
_scst_failed
=
Just
0
,
_scst_failed
=
Just
0
,
_scst_remaining
=
Just
1
,
_scst_remaining
=
Just
1
...
@@ -86,8 +89,11 @@ documentUpload uId nId doc logStatus = do
...
@@ -86,8 +89,11 @@ documentUpload uId nId doc logStatus = do
Just
c
->
c
Just
c
->
c
Nothing
->
panic
$
T
.
pack
$
"[G.A.N.DU] Node has no corpus parent: "
<>
show
nId
Nothing
->
panic
$
T
.
pack
$
"[G.A.N.DU] Node has no corpus parent: "
<>
show
nId
(
year
,
month
,
day
)
<-
liftBase
$
getCurrentTime
>>=
return
.
toGregorian
.
utctDay
(
theFullDate
,
(
year
,
month
,
day
))
<-
liftBase
let
nowS
=
T
.
pack
$
show
year
<>
"-"
<>
show
month
<>
"-"
<>
show
day
$
dateSplit
EN
$
Just
$
view
du_date
doc
<>
"T:0:0:0"
let
hd
=
HyperdataDocument
{
_hd_bdd
=
Nothing
let
hd
=
HyperdataDocument
{
_hd_bdd
=
Nothing
,
_hd_doi
=
Nothing
,
_hd_doi
=
Nothing
,
_hd_url
=
Nothing
,
_hd_url
=
Nothing
...
@@ -99,14 +105,16 @@ documentUpload uId nId doc logStatus = do
...
@@ -99,14 +105,16 @@ documentUpload uId nId doc logStatus = do
,
_hd_institutes
=
Nothing
,
_hd_institutes
=
Nothing
,
_hd_source
=
Just
$
view
du_sources
doc
,
_hd_source
=
Just
$
view
du_sources
doc
,
_hd_abstract
=
Just
$
view
du_abstract
doc
,
_hd_abstract
=
Just
$
view
du_abstract
doc
,
_hd_publication_date
=
Just
nowS
,
_hd_publication_date
=
fmap
(
T
.
pack
.
show
)
theFullDate
,
_hd_publication_year
=
Just
$
fromIntegral
year
,
_hd_publication_year
=
year
,
_hd_publication_month
=
Just
month
,
_hd_publication_month
=
month
,
_hd_publication_day
=
Just
day
,
_hd_publication_day
=
day
,
_hd_publication_hour
=
Nothing
,
_hd_publication_hour
=
Nothing
,
_hd_publication_minute
=
Nothing
,
_hd_publication_minute
=
Nothing
,
_hd_publication_second
=
Nothing
,
_hd_publication_second
=
Nothing
,
_hd_language_iso2
=
Just
$
T
.
pack
$
show
EN
}
,
_hd_language_iso2
=
Just
$
T
.
pack
$
show
EN
}
_
<-
flowDataText
(
RootId
(
NodeId
uId
))
(
DataNew
[[
hd
]])
(
Multi
EN
)
cId
Nothing
logStatus
docIds
<-
insertMasterDocs
(
Nothing
::
Maybe
HyperdataCorpus
)
(
Multi
EN
)
[
hd
]
_
<-
Doc
.
add
cId
docIds
pure
$
jobLogSuccess
jl
pure
$
jobLogSuccess
jl
src/Gargantext/Core/Methods/Distances.hs
View file @
d42d7f26
...
@@ -14,14 +14,14 @@ Portability : POSIX
...
@@ -14,14 +14,14 @@ Portability : POSIX
module
Gargantext.Core.Methods.Distances
module
Gargantext.Core.Methods.Distances
where
where
--
import Debug.Trace (trace)
import
Debug.Trace
(
trace
)
import
Data.Aeson
import
Data.Aeson
import
Data.Array.Accelerate
(
Matrix
)
import
Data.Array.Accelerate
(
Matrix
)
import
Data.Swagger
import
Data.Swagger
import
GHC.Generics
(
Generic
)
import
GHC.Generics
(
Generic
)
import
Gargantext.Core.Methods.Distances.Accelerate.Conditional
(
measureConditional
)
import
Gargantext.Core.Methods.Distances.Accelerate.Conditional
(
measureConditional
)
import
Gargantext.Core.Methods.Distances.Accelerate.Distributional
(
logDistributional
)
import
Gargantext.Core.Methods.Distances.Accelerate.Distributional
(
logDistributional
)
import
Gargantext.Prelude
(
Ord
,
Eq
,
Int
,
Double
,
Show
{-, ($), show-}
)
import
Gargantext.Prelude
(
Ord
,
Eq
,
Int
,
Double
,
Show
,
(
$
),
show
)
import
Prelude
(
Enum
,
Bounded
,
minBound
,
maxBound
)
import
Prelude
(
Enum
,
Bounded
,
minBound
,
maxBound
)
import
Test.QuickCheck
(
elements
)
import
Test.QuickCheck
(
elements
)
import
Test.QuickCheck.Arbitrary
import
Test.QuickCheck.Arbitrary
...
@@ -31,8 +31,10 @@ data Distance = Conditional | Distributional
...
@@ -31,8 +31,10 @@ data Distance = Conditional | Distributional
deriving
(
Show
,
Eq
)
deriving
(
Show
,
Eq
)
measure
::
Distance
->
Matrix
Int
->
Matrix
Double
measure
::
Distance
->
Matrix
Int
->
Matrix
Double
measure
Conditional
=
measureConditional
measure
Conditional
x
=
measureConditional
x
measure
Distributional
=
logDistributional
measure
Distributional
x
=
trace
(
show
y
)
$
y
where
y
=
logDistributional
x
------------------------------------------------------------------------
------------------------------------------------------------------------
withMetric
::
GraphMetric
->
Distance
withMetric
::
GraphMetric
->
Distance
...
...
src/Gargantext/Core/Viz/Graph/Bridgeness.hs
View file @
d42d7f26
...
@@ -77,7 +77,6 @@ groupEdges m = fromListWith (<>)
...
@@ -77,7 +77,6 @@ groupEdges m = fromListWith (<>)
.
toList
.
toList
-- | TODO : sortOn Confluence
-- | TODO : sortOn Confluence
filterComs
::
(
Ord
n1
,
Eq
n2
)
filterComs
::
(
Ord
n1
,
Eq
n2
)
=>
p
=>
p
->
Map
(
n2
,
n2
)
[(
a3
,
n1
)]
->
Map
(
n2
,
n2
)
[(
a3
,
n1
)]
...
...
src/Gargantext/Core/Viz/Graph/Tools.hs
View file @
d42d7f26
...
@@ -67,7 +67,7 @@ cooc2graph' distance threshold myCooc
...
@@ -67,7 +67,7 @@ cooc2graph' distance threshold myCooc
myCooc'
=
toIndex
ti
myCooc
myCooc'
=
toIndex
ti
myCooc
data
PartitionMethod
=
Louvain
|
Spinglass
data
PartitionMethod
=
Louvain
|
Spinglass
|
Bac
-- | coocurrences graph computation
-- | coocurrences graph computation
cooc2graphWith
::
PartitionMethod
cooc2graphWith
::
PartitionMethod
...
@@ -77,6 +77,7 @@ cooc2graphWith :: PartitionMethod
...
@@ -77,6 +77,7 @@ cooc2graphWith :: PartitionMethod
->
IO
Graph
->
IO
Graph
cooc2graphWith
Louvain
=
undefined
-- TODO use IGraph bindings
cooc2graphWith
Louvain
=
undefined
-- TODO use IGraph bindings
cooc2graphWith
Spinglass
=
cooc2graphWith'
(
spinglass
1
)
cooc2graphWith
Spinglass
=
cooc2graphWith'
(
spinglass
1
)
cooc2graphWith
Bac
=
undefined
-- cooc2graphWith' BAC.defaultClustering
cooc2graph''
::
Ord
t
=>
Distance
cooc2graph''
::
Ord
t
=>
Distance
->
Double
->
Double
...
@@ -179,7 +180,6 @@ cooc2graphWith' doPartitions distance threshold myCooc = do
...
@@ -179,7 +180,6 @@ cooc2graphWith' doPartitions distance threshold myCooc = do
pure
$
data2graph
(
Map
.
toList
$
Map
.
mapKeys
unNgramsTerm
ti
)
pure
$
data2graph
(
Map
.
toList
$
Map
.
mapKeys
unNgramsTerm
ti
)
myCooc'
bridgeness'
confluence'
partitions
myCooc'
bridgeness'
confluence'
partitions
------------------------------------------------------------------------
------------------------------------------------------------------------
------------------------------------------------------------------------
------------------------------------------------------------------------
data
ClustersParams
=
ClustersParams
{
bridgness
::
Double
data
ClustersParams
=
ClustersParams
{
bridgness
::
Double
...
...
src/Gargantext/Database/Action/Mail.hs
View file @
d42d7f26
...
@@ -30,5 +30,7 @@ sendMail u = do
...
@@ -30,5 +30,7 @@ sendMail u = do
cfg
<-
view
$
mailSettings
cfg
<-
view
$
mailSettings
userLight
<-
getUserLightDB
u
userLight
<-
getUserLightDB
u
mail
cfg
(
MailInfo
{
mailInfo_username
=
userLight_username
userLight
mail
cfg
(
MailInfo
{
mailInfo_username
=
userLight_username
userLight
,
mailInfo_address
=
userLight_email
userLight
})
,
mailInfo_address
=
userLight_email
userLight
}
)
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