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
f7dd4a98
Commit
f7dd4a98
authored
Nov 20, 2021
by
Alexandre Delanoë
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
[FIX] Unary document upload
parent
233f89cc
Changes
5
Hide whitespace changes
Inline
Side-by-side
Showing
5 changed files
with
38 additions
and
27 deletions
+38
-27
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.
src/Gargantext/API/Node/DocumentUpload.hs
View file @
f7dd4a98
...
...
@@ -8,32 +8,35 @@ module Gargantext.API.Node.DocumentUpload where
import
Control.Lens
(
makeLenses
,
view
)
import
Data.Aeson
import
Data.Swagger
(
ToSchema
)
import
qualified
Data.Text
as
T
import
Data.Time.Clock
import
Data.Time.Calendar
import
GHC.Generics
(
Generic
)
import
Servant
import
Servant.Job.Async
import
qualified
Data.Text
as
T
import
Gargantext.API.Admin.Orchestrator.Types
(
JobLog
(
..
),
AsyncJobs
)
import
Gargantext.API.Job
(
jobLogSuccess
)
import
Gargantext.API.Prelude
import
Gargantext.Core
(
Lang
(
..
))
import
Gargantext.Core.Text.Terms
(
TermType
(
..
))
import
Gargantext.Core.Types.Individu
(
User
(
..
))
import
Gargantext.Core.Text.Corpus.Parsers.Date
(
dateSplit
)
import
Gargantext.Core.Utils.Prefix
(
unCapitalize
,
dropPrefix
)
import
Gargantext.Database.Action.Flow
(
flowDataText
,
DataText
(
..
))
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
qualified
Gargantext.Database.Query.Table.Node.Document.Add
as
Doc
(
add
)
import
Gargantext.Database.Admin.Types.Node
import
Gargantext.Database.Query.Table.Node
(
getClosestParentIdByType'
)
import
Gargantext.Prelude
import
Gargantext.Database.Admin.Types.Hyperdata.Corpus
(
HyperdataCorpus
(
..
))
data
DocumentUpload
=
DocumentUpload
{
_du_abstract
::
T
.
Text
,
_du_authors
::
T
.
Text
,
_du_sources
::
T
.
Text
,
_du_title
::
T
.
Text
}
,
_du_title
::
T
.
Text
,
_du_date
::
T
.
Text
}
deriving
(
Generic
)
$
(
makeLenses
''
D
ocumentUpload
)
...
...
@@ -75,7 +78,7 @@ documentUpload :: (FlowCmdM env err m)
->
DocumentUpload
->
(
JobLog
->
m
()
)
->
m
JobLog
documentUpload
uId
nId
doc
logStatus
=
do
documentUpload
_
uId
nId
doc
logStatus
=
do
let
jl
=
JobLog
{
_scst_succeeded
=
Just
0
,
_scst_failed
=
Just
0
,
_scst_remaining
=
Just
1
...
...
@@ -85,9 +88,12 @@ documentUpload uId nId doc logStatus = do
let
cId
=
case
mcId
of
Just
c
->
c
Nothing
->
panic
$
T
.
pack
$
"[G.A.N.DU] Node has no corpus parent: "
<>
show
nId
(
theFullDate
,
(
year
,
month
,
day
))
<-
liftBase
$
dateSplit
EN
$
Just
$
view
du_date
doc
<>
"T:0:0:0"
(
year
,
month
,
day
)
<-
liftBase
$
getCurrentTime
>>=
return
.
toGregorian
.
utctDay
let
nowS
=
T
.
pack
$
show
year
<>
"-"
<>
show
month
<>
"-"
<>
show
day
let
hd
=
HyperdataDocument
{
_hd_bdd
=
Nothing
,
_hd_doi
=
Nothing
,
_hd_url
=
Nothing
...
...
@@ -97,16 +103,18 @@ documentUpload uId nId doc logStatus = do
,
_hd_title
=
Just
$
view
du_title
doc
,
_hd_authors
=
Just
$
view
du_authors
doc
,
_hd_institutes
=
Nothing
,
_hd_source
=
Just
$
view
du_sources
doc
,
_hd_abstract
=
Just
$
view
du_abstract
doc
,
_hd_publication_date
=
Just
nowS
,
_hd_publication_year
=
Just
$
fromIntegral
year
,
_hd_publication_month
=
Just
month
,
_hd_publication_day
=
Just
day
,
_hd_publication_hour
=
Nothing
,
_hd_source
=
Just
$
view
du_sources
doc
,
_hd_abstract
=
Just
$
view
du_abstract
doc
,
_hd_publication_date
=
fmap
(
T
.
pack
.
show
)
theFullDate
,
_hd_publication_year
=
year
,
_hd_publication_month
=
month
,
_hd_publication_day
=
day
,
_hd_publication_hour
=
Nothing
,
_hd_publication_minute
=
Nothing
,
_hd_publication_second
=
Nothing
,
_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
src/Gargantext/Core/Methods/Distances.hs
View file @
f7dd4a98
...
...
@@ -14,14 +14,14 @@ Portability : POSIX
module
Gargantext.Core.Methods.Distances
where
--
import Debug.Trace (trace)
import
Debug.Trace
(
trace
)
import
Data.Aeson
import
Data.Array.Accelerate
(
Matrix
)
import
Data.Swagger
import
GHC.Generics
(
Generic
)
import
Gargantext.Core.Methods.Distances.Accelerate.Conditional
(
measureConditional
)
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
Test.QuickCheck
(
elements
)
import
Test.QuickCheck.Arbitrary
...
...
@@ -31,8 +31,10 @@ data Distance = Conditional | Distributional
deriving
(
Show
,
Eq
)
measure
::
Distance
->
Matrix
Int
->
Matrix
Double
measure
Conditional
=
measureConditional
measure
Distributional
=
logDistributional
measure
Conditional
x
=
measureConditional
x
measure
Distributional
x
=
trace
(
show
y
)
$
y
where
y
=
logDistributional
x
------------------------------------------------------------------------
withMetric
::
GraphMetric
->
Distance
...
...
src/Gargantext/Core/Viz/Graph/Bridgeness.hs
View file @
f7dd4a98
...
...
@@ -77,7 +77,6 @@ groupEdges m = fromListWith (<>)
.
toList
-- | TODO : sortOn Confluence
filterComs
::
(
Ord
n1
,
Eq
n2
)
=>
p
->
Map
(
n2
,
n2
)
[(
a3
,
n1
)]
...
...
src/Gargantext/Core/Viz/Graph/Tools.hs
View file @
f7dd4a98
...
...
@@ -67,7 +67,7 @@ cooc2graph' distance threshold myCooc
myCooc'
=
toIndex
ti
myCooc
data
PartitionMethod
=
Louvain
|
Spinglass
data
PartitionMethod
=
Louvain
|
Spinglass
|
Bac
-- | coocurrences graph computation
cooc2graphWith
::
PartitionMethod
...
...
@@ -77,6 +77,7 @@ cooc2graphWith :: PartitionMethod
->
IO
Graph
cooc2graphWith
Louvain
=
undefined
-- TODO use IGraph bindings
cooc2graphWith
Spinglass
=
cooc2graphWith'
(
spinglass
1
)
cooc2graphWith
Bac
=
undefined
-- cooc2graphWith' BAC.defaultClustering
cooc2graph''
::
Ord
t
=>
Distance
->
Double
...
...
@@ -179,7 +180,6 @@ cooc2graphWith' doPartitions distance threshold myCooc = do
pure
$
data2graph
(
Map
.
toList
$
Map
.
mapKeys
unNgramsTerm
ti
)
myCooc'
bridgeness'
confluence'
partitions
------------------------------------------------------------------------
------------------------------------------------------------------------
data
ClustersParams
=
ClustersParams
{
bridgness
::
Double
...
...
src/Gargantext/Database/Action/Mail.hs
View file @
f7dd4a98
...
...
@@ -27,8 +27,10 @@ import Gargantext.Prelude
sendMail
::
(
HasNodeError
err
,
CmdM
env
err
m
)
=>
User
->
m
()
sendMail
u
=
do
cfg
<-
view
$
mailSettings
cfg
<-
view
$
mailSettings
userLight
<-
getUserLightDB
u
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