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
152
Issues
152
List
Board
Labels
Milestones
Merge Requests
9
Merge Requests
9
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
95270542
Commit
95270542
authored
Mar 02, 2022
by
Przemyslaw Kaminski
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
[conduit] some refactoring
parent
b8852dea
Pipeline
#2524
failed with stage
in 9 minutes and 14 seconds
Changes
3
Pipelines
1
Hide whitespace changes
Inline
Side-by-side
Showing
3 changed files
with
12 additions
and
18 deletions
+12
-18
New.hs
src/Gargantext/API/Node/Corpus/New.hs
+6
-11
Pubmed.hs
src/Gargantext/Core/Text/Corpus/API/Pubmed.hs
+4
-3
Flow.hs
src/Gargantext/Database/Action/Flow.hs
+2
-4
No files found.
src/Gargantext/API/Node/Corpus/New.hs
View file @
95270542
...
@@ -52,7 +52,7 @@ import qualified Gargantext.Core.Text.Corpus.API as API
...
@@ -52,7 +52,7 @@ import qualified Gargantext.Core.Text.Corpus.API as API
import
qualified
Gargantext.Core.Text.Corpus.Parsers
as
Parser
(
FileFormat
(
..
),
parseFormat
)
import
qualified
Gargantext.Core.Text.Corpus.Parsers
as
Parser
(
FileFormat
(
..
),
parseFormat
)
import
Gargantext.Core.Types.Individu
(
User
(
..
))
import
Gargantext.Core.Types.Individu
(
User
(
..
))
import
Gargantext.Core.Utils.Prefix
(
unPrefix
,
unPrefixSwagger
)
import
Gargantext.Core.Utils.Prefix
(
unPrefix
,
unPrefixSwagger
)
import
Gargantext.Database.Action.Flow
(
flowCorpus
,
getDataText
,
flowDataText
,
DataText
(
..
),
TermType
(
..
)
{-, allDataOrigins-}
)
import
Gargantext.Database.Action.Flow
(
flowCorpus
,
getDataText
,
flowDataText
,
TermType
(
..
)
{-, allDataOrigins-}
)
import
Gargantext.Database.Action.Flow.Types
(
FlowCmdM
)
import
Gargantext.Database.Action.Flow.Types
(
FlowCmdM
)
import
Gargantext.Database.Action.Mail
(
sendMail
)
import
Gargantext.Database.Action.Mail
(
sendMail
)
import
Gargantext.Database.Action.Node
(
mkNodeWithParent
)
import
Gargantext.Database.Action.Node
(
mkNodeWithParent
)
...
@@ -221,18 +221,13 @@ addToCorpusWithQuery user cid (WithQuery { _wq_query = q
...
@@ -221,18 +221,13 @@ addToCorpusWithQuery user cid (WithQuery { _wq_query = q
[]
->
do
[]
->
do
let
txts
=
rights
eTxts
let
txts
=
rights
eTxts
-- TODO Sum lenghts of each txt elements
-- TODO Sum lenghts of each txt elements
let
jl
=
JobLog
{
_scst_succeeded
=
Just
2
logStatus
$
JobLog
{
_scst_succeeded
=
Just
2
,
_scst_failed
=
Just
0
,
_scst_failed
=
Just
0
,
_scst_remaining
=
Just
$
1
+
length
txts
,
_scst_remaining
=
Just
$
1
+
length
txts
,
_scst_events
=
Just
[]
,
_scst_events
=
Just
[]
}
}
logStatus
jl
cids
<-
mapM
(
\
txt
->
do
cids
<-
mapM
(
\
txt
->
do
let
id
=
case
txt
of
(
DataNew
(
i
,
_
))
->
i
_
->
(
Just
0
)
logStatus
$
addEvent
"INFO: doc id"
(
T
.
pack
$
show
id
)
jl
flowDataText
user
txt
(
Multi
l
)
cid
Nothing
logStatus
)
txts
flowDataText
user
txt
(
Multi
l
)
cid
Nothing
logStatus
)
txts
printDebug
"corpus id"
cids
printDebug
"corpus id"
cids
printDebug
"sending email"
(
"xxxxxxxxxxxxxxxxxxxxx"
::
Text
)
printDebug
"sending email"
(
"xxxxxxxxxxxxxxxxxxxxx"
::
Text
)
...
...
src/Gargantext/Core/Text/Corpus/API/Pubmed.hs
View file @
95270542
...
@@ -42,12 +42,13 @@ get q l = do
...
@@ -42,12 +42,13 @@ get q l = do
-- <$> PubMed.getMetadataWithC q l
-- <$> PubMed.getMetadataWithC q l
toDoc
::
Lang
->
PubMedDoc
.
PubMed
->
HyperdataDocument
toDoc
::
Lang
->
PubMedDoc
.
PubMed
->
HyperdataDocument
toDoc
l
(
PubMedDoc
.
PubMed
(
PubMedDoc
.
PubMedArticle
t
j
as
aus
)
toDoc
l
(
PubMedDoc
.
PubMed
{
pubmed_id
(
PubMedDoc
.
PubMedDate
a
y
m
d
)
,
pubmed_article
=
PubMedDoc
.
PubMedArticle
t
j
as
aus
,
pubmed_date
=
PubMedDoc
.
PubMedDate
a
y
m
d
}
)
=
HyperdataDocument
{
_hd_bdd
=
Just
"PubMed"
)
=
HyperdataDocument
{
_hd_bdd
=
Just
"PubMed"
,
_hd_doi
=
Nothing
,
_hd_doi
=
Nothing
,
_hd_url
=
Nothing
,
_hd_url
=
Nothing
,
_hd_uniqId
=
Nothing
,
_hd_uniqId
=
Just
$
Text
.
pack
$
show
pubmed_id
,
_hd_uniqIdBdd
=
Nothing
,
_hd_uniqIdBdd
=
Nothing
,
_hd_page
=
Nothing
,
_hd_page
=
Nothing
,
_hd_title
=
t
,
_hd_title
=
t
...
...
src/Gargantext/Database/Action/Flow.hs
View file @
95270542
...
@@ -168,7 +168,7 @@ flowDataText u (DataOld ids) tt cid mfslw _ = flowCorpusUser (_tt_lang tt) u (Ri
...
@@ -168,7 +168,7 @@ flowDataText u (DataOld ids) tt cid mfslw _ = flowCorpusUser (_tt_lang tt) u (Ri
where
where
corpusType
=
(
Nothing
::
Maybe
HyperdataCorpus
)
corpusType
=
(
Nothing
::
Maybe
HyperdataCorpus
)
flowDataText
u
(
DataNew
(
mLen
,
txtC
))
tt
cid
mfslw
logStatus
=
flowDataText
u
(
DataNew
(
mLen
,
txtC
))
tt
cid
mfslw
logStatus
=
flowCorpus
u
(
Right
[
cid
])
tt
mfslw
(
mLen
,
transPipe
liftBase
txtC
)
logStatus
flowCorpus
u
(
Right
[
cid
])
tt
mfslw
(
mLen
,
(
transPipe
liftBase
txtC
)
)
logStatus
------------------------------------------------------------------------
------------------------------------------------------------------------
-- TODO use proxy
-- TODO use proxy
...
@@ -252,7 +252,7 @@ flow c u cn la mfslw (mLength, docsC) logStatus = do
...
@@ -252,7 +252,7 @@ flow c u cn la mfslw (mLength, docsC) logStatus = do
id
<-
insertMasterDocs
c
la
[
doc
]
id
<-
insertMasterDocs
c
la
[
doc
]
case
mLength
of
case
mLength
of
Nothing
->
pure
()
Nothing
->
pure
()
Just
len
->
Just
len
->
do
logStatus
JobLog
{
_scst_succeeded
=
Just
$
fromIntegral
$
1
+
idx
logStatus
JobLog
{
_scst_succeeded
=
Just
$
fromIntegral
$
1
+
idx
,
_scst_failed
=
Just
0
,
_scst_failed
=
Just
0
,
_scst_remaining
=
Just
$
fromIntegral
$
len
-
idx
,
_scst_remaining
=
Just
$
fromIntegral
$
len
-
idx
...
@@ -531,5 +531,3 @@ extractInsert docs = do
...
@@ -531,5 +531,3 @@ extractInsert docs = do
documentsWithId
documentsWithId
_
<-
insertExtractedNgrams
$
HashMap
.
keys
mapNgramsDocs'
_
<-
insertExtractedNgrams
$
HashMap
.
keys
mapNgramsDocs'
pure
()
pure
()
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