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
195
Issues
195
List
Board
Labels
Milestones
Merge Requests
11
Merge Requests
11
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
c079ceb0
Commit
c079ceb0
authored
Dec 24, 2022
by
Alexandre Delanoë
Browse files
Options
Browse Files
Download
Plain Diff
Merge remote-tracking branch 'origin/161-dev-conduit-insert-db-fix' into dev-merge
parents
558accb3
56eb1b5c
Changes
2
Hide whitespace changes
Inline
Side-by-side
Showing
2 changed files
with
14 additions
and
9 deletions
+14
-9
Flow.hs
src-test/Core/Text/Flow.hs
+0
-1
Flow.hs
src/Gargantext/Database/Action/Flow.hs
+14
-8
No files found.
src-test/Core/Text/Flow.hs
View file @
c079ceb0
...
...
@@ -95,4 +95,3 @@ textFlow' termType contexts = do
g <- cooc2graph myCooc2
pure g
-}
src/Gargantext/Database/Action/Flow.hs
View file @
c079ceb0
...
...
@@ -53,6 +53,7 @@ import Control.Lens ((^.), view, _Just, makeLenses, over, traverse)
import
Control.Monad.Reader
(
MonadReader
)
import
Data.Aeson.TH
(
deriveJSON
)
import
Data.Conduit.Internal
(
zipSources
)
import
qualified
Data.Conduit.List
as
CList
import
Data.Either
import
Data.HashMap.Strict
(
HashMap
)
import
Data.Hashable
(
Hashable
)
...
...
@@ -111,7 +112,7 @@ import Gargantext.Prelude
import
Gargantext.Prelude.Crypto.Hash
(
Hash
)
import
qualified
Gargantext.Core.Text.Corpus.API
as
API
import
qualified
Gargantext.Database.Query.Table.Node.Document.Add
as
Doc
(
add
)
import
qualified
Prelude
--
import qualified Prelude
------------------------------------------------------------------------
-- Imports for upgrade function
...
...
@@ -264,7 +265,9 @@ flow :: forall env err m a c.
flow
c
u
cn
la
mfslw
(
mLength
,
docsC
)
logStatus
=
do
-- TODO if public insertMasterDocs else insertUserDocs
ids
<-
runConduit
$
zipSources
(
yieldMany
[
1
..
])
docsC
.|
mapMC
insertDoc
.|
CList
.
chunksOf
100
.|
mapMC
insertDocs'
.|
CList
.
concat
.|
sinkList
-- ids <- traverse (\(idx, doc) -> do
-- id <- insertMasterDocs c la doc
...
...
@@ -278,18 +281,21 @@ flow c u cn la mfslw (mLength, docsC) logStatus = do
flowCorpusUser
(
la
^.
tt_lang
)
u
cn
c
ids
mfslw
where
insertDoc
::
(
Integer
,
a
)
->
m
NodeId
insertDoc
(
idx
,
doc
)
=
do
id
<-
insertMasterDocs
c
la
[
doc
]
insertDocs'
::
[(
Integer
,
a
)]
->
m
[
NodeId
]
insertDocs'
[]
=
pure
[]
insertDocs'
docs
=
do
printDebug
"[flow] calling insertDoc, ([idx], mLength) = "
(
fst
<$>
docs
,
mLength
)
ids
<-
insertMasterDocs
c
la
(
snd
<$>
docs
)
let
maxIdx
=
maximum
(
fst
<$>
docs
)
case
mLength
of
Nothing
->
pure
()
Just
len
->
do
logStatus
JobLog
{
_scst_succeeded
=
Just
$
fromIntegral
$
1
+
i
dx
logStatus
JobLog
{
_scst_succeeded
=
Just
$
fromIntegral
$
1
+
maxI
dx
,
_scst_failed
=
Just
0
,
_scst_remaining
=
Just
$
fromIntegral
$
len
-
i
dx
,
_scst_remaining
=
Just
$
fromIntegral
$
len
-
maxI
dx
,
_scst_events
=
Just
[]
}
pure
$
Prelude
.
head
id
pure
ids
...
...
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