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
153
Issues
153
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
c079ceb0
Commit
c079ceb0
authored
2 years ago
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
...
@@ -95,4 +95,3 @@ textFlow' termType contexts = do
g <- cooc2graph myCooc2
g <- cooc2graph myCooc2
pure g
pure g
-}
-}
This diff is collapsed.
Click to expand it.
src/Gargantext/Database/Action/Flow.hs
View file @
c079ceb0
...
@@ -53,6 +53,7 @@ import Control.Lens ((^.), view, _Just, makeLenses, over, traverse)
...
@@ -53,6 +53,7 @@ import Control.Lens ((^.), view, _Just, makeLenses, over, traverse)
import
Control.Monad.Reader
(
MonadReader
)
import
Control.Monad.Reader
(
MonadReader
)
import
Data.Aeson.TH
(
deriveJSON
)
import
Data.Aeson.TH
(
deriveJSON
)
import
Data.Conduit.Internal
(
zipSources
)
import
Data.Conduit.Internal
(
zipSources
)
import
qualified
Data.Conduit.List
as
CList
import
Data.Either
import
Data.Either
import
Data.HashMap.Strict
(
HashMap
)
import
Data.HashMap.Strict
(
HashMap
)
import
Data.Hashable
(
Hashable
)
import
Data.Hashable
(
Hashable
)
...
@@ -111,7 +112,7 @@ import Gargantext.Prelude
...
@@ -111,7 +112,7 @@ import Gargantext.Prelude
import
Gargantext.Prelude.Crypto.Hash
(
Hash
)
import
Gargantext.Prelude.Crypto.Hash
(
Hash
)
import
qualified
Gargantext.Core.Text.Corpus.API
as
API
import
qualified
Gargantext.Core.Text.Corpus.API
as
API
import
qualified
Gargantext.Database.Query.Table.Node.Document.Add
as
Doc
(
add
)
import
qualified
Gargantext.Database.Query.Table.Node.Document.Add
as
Doc
(
add
)
import
qualified
Prelude
--
import qualified Prelude
------------------------------------------------------------------------
------------------------------------------------------------------------
-- Imports for upgrade function
-- Imports for upgrade function
...
@@ -264,7 +265,9 @@ flow :: forall env err m a c.
...
@@ -264,7 +265,9 @@ flow :: forall env err m a c.
flow
c
u
cn
la
mfslw
(
mLength
,
docsC
)
logStatus
=
do
flow
c
u
cn
la
mfslw
(
mLength
,
docsC
)
logStatus
=
do
-- TODO if public insertMasterDocs else insertUserDocs
-- TODO if public insertMasterDocs else insertUserDocs
ids
<-
runConduit
$
zipSources
(
yieldMany
[
1
..
])
docsC
ids
<-
runConduit
$
zipSources
(
yieldMany
[
1
..
])
docsC
.|
mapMC
insertDoc
.|
CList
.
chunksOf
100
.|
mapMC
insertDocs'
.|
CList
.
concat
.|
sinkList
.|
sinkList
-- ids <- traverse (\(idx, doc) -> do
-- ids <- traverse (\(idx, doc) -> do
-- id <- insertMasterDocs c la doc
-- id <- insertMasterDocs c la doc
...
@@ -278,18 +281,21 @@ flow c u cn la mfslw (mLength, docsC) logStatus = do
...
@@ -278,18 +281,21 @@ flow c u cn la mfslw (mLength, docsC) logStatus = do
flowCorpusUser
(
la
^.
tt_lang
)
u
cn
c
ids
mfslw
flowCorpusUser
(
la
^.
tt_lang
)
u
cn
c
ids
mfslw
where
where
insertDoc
::
(
Integer
,
a
)
->
m
NodeId
insertDocs'
::
[(
Integer
,
a
)]
->
m
[
NodeId
]
insertDoc
(
idx
,
doc
)
=
do
insertDocs'
[]
=
pure
[]
id
<-
insertMasterDocs
c
la
[
doc
]
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
case
mLength
of
Nothing
->
pure
()
Nothing
->
pure
()
Just
len
->
do
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_failed
=
Just
0
,
_scst_remaining
=
Just
$
fromIntegral
$
len
-
i
dx
,
_scst_remaining
=
Just
$
fromIntegral
$
len
-
maxI
dx
,
_scst_events
=
Just
[]
,
_scst_events
=
Just
[]
}
}
pure
$
Prelude
.
head
id
pure
ids
...
...
This diff is collapsed.
Click to expand it.
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