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
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