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
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
06477f7b
Commit
06477f7b
authored
Mar 16, 2022
by
Przemyslaw Kaminski
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
[conduit] parsers length works so full progress report should work as well
parent
8cdbff09
Pipeline
#2567
failed with stage
in 43 minutes and 32 seconds
Changes
3
Pipelines
1
Hide whitespace changes
Inline
Side-by-side
Showing
3 changed files
with
12 additions
and
12 deletions
+12
-12
New.hs
src/Gargantext/API/Node/Corpus/New.hs
+3
-3
Parsers.hs
src/Gargantext/Core/Text/Corpus/Parsers.hs
+8
-8
CSV.hs
src/Gargantext/Core/Text/Corpus/Parsers/CSV.hs
+1
-1
No files found.
src/Gargantext/API/Node/Corpus/New.hs
View file @
06477f7b
...
@@ -286,7 +286,7 @@ addToCorpusWithForm user cid (NewWithForm ft ff d l _n) logStatus jobLog = do
...
@@ -286,7 +286,7 @@ addToCorpusWithForm user cid (NewWithForm ft ff d l _n) logStatus jobLog = do
Right
decoded
->
decoded
Right
decoded
->
decoded
eDocsC
<-
liftBase
$
parseC
ff
data
'
eDocsC
<-
liftBase
$
parseC
ff
data
'
case
eDocsC
of
case
eDocsC
of
Right
docsC
->
do
Right
(
mCount
,
docsC
)
->
do
-- TODO Add progress (jobStatus) update for docs - this is a
-- TODO Add progress (jobStatus) update for docs - this is a
-- long action
-- long action
...
@@ -315,9 +315,9 @@ addToCorpusWithForm user cid (NewWithForm ft ff d l _n) logStatus jobLog = do
...
@@ -315,9 +315,9 @@ addToCorpusWithForm user cid (NewWithForm ft ff d l _n) logStatus jobLog = do
(
Multi
$
fromMaybe
EN
l
)
(
Multi
$
fromMaybe
EN
l
)
Nothing
Nothing
--(Just $ fromIntegral $ length docs, docsC')
--(Just $ fromIntegral $ length docs, docsC')
(
Just
0
,
transPipe
liftBase
docsC'
)
-- TODO fix number of docs
(
mCount
,
transPipe
liftBase
docsC'
)
-- TODO fix number of docs
--(map (map toHyperdataDocument) docs)
--(map (map toHyperdataDocument) docs)
(
logStatus
)
logStatus
printDebug
"Extraction finished : "
cid
printDebug
"Extraction finished : "
cid
printDebug
"sending email"
(
"xxxxxxxxxxxxxxxxxxxxx"
::
Text
)
printDebug
"sending email"
(
"xxxxxxxxxxxxxxxxxxxxx"
::
Text
)
...
...
src/Gargantext/Core/Text/Corpus/Parsers.hs
View file @
06477f7b
...
@@ -85,20 +85,20 @@ parseFormatC :: MonadBaseControl IO m
...
@@ -85,20 +85,20 @@ parseFormatC :: MonadBaseControl IO m
->
DB
.
ByteString
->
DB
.
ByteString
->
m
(
Either
Prelude
.
String
(
Maybe
Integer
,
ConduitT
()
HyperdataDocument
IO
()
))
->
m
(
Either
Prelude
.
String
(
Maybe
Integer
,
ConduitT
()
HyperdataDocument
IO
()
))
parseFormatC
CsvGargV3
Plain
bs
=
do
parseFormatC
CsvGargV3
Plain
bs
=
do
eParsedC
<-
parseCsvC
$
DBL
.
fromStrict
bs
let
eParsedC
=
parseCsvC
$
DBL
.
fromStrict
bs
case
eParsedC
of
case
eParsedC
of
Left
err
->
pure
$
Left
err
Left
err
->
pure
$
Left
err
Right
(
mLen
,
parsedC
)
->
pure
$
(
mLen
,
transPipe
(
pure
.
runIdentity
)
parsedC
)
Right
(
mLen
,
parsedC
)
->
pure
$
Right
(
mLen
,
transPipe
(
pure
.
runIdentity
)
parsedC
)
parseFormatC
CsvHal
Plain
bs
=
do
parseFormatC
CsvHal
Plain
bs
=
do
eParsedC
<-
parseCsvC
$
DBL
.
fromStrict
bs
let
eParsedC
=
parseCsvC
$
DBL
.
fromStrict
bs
case
eParsedC
of
case
eParsedC
of
Left
err
->
pure
$
Left
err
Left
err
->
pure
$
Left
err
Right
(
mLen
,
parsedC
)
->
pure
$
(
mLen
,
transPipe
(
pure
.
runIdentity
)
parsedC
)
Right
(
mLen
,
parsedC
)
->
pure
$
Right
(
mLen
,
transPipe
(
pure
.
runIdentity
)
parsedC
)
parseFormatC
RisPresse
Plain
bs
=
do
parseFormatC
RisPresse
Plain
bs
=
do
--docs <- enrichWith RisPresse
--docs <- enrichWith RisPresse
let
eDocs
=
runParser'
RisPresse
bs
let
eDocs
=
runParser'
RisPresse
bs
pure
$
(
\
docs
->
pure
$
(
\
docs
->
(
Just
$
length
docs
(
Just
$
fromIntegral
$
length
docs
,
yieldMany
docs
,
yieldMany
docs
.|
mapC
presseEnrich
.|
mapC
presseEnrich
.|
mapC
(
map
$
both
decodeUtf8
)
.|
mapC
(
map
$
both
decodeUtf8
)
...
@@ -106,7 +106,7 @@ parseFormatC RisPresse Plain bs = do
...
@@ -106,7 +106,7 @@ parseFormatC RisPresse Plain bs = do
parseFormatC
WOS
Plain
bs
=
do
parseFormatC
WOS
Plain
bs
=
do
let
eDocs
=
runParser'
WOS
bs
let
eDocs
=
runParser'
WOS
bs
pure
$
(
\
docs
->
pure
$
(
\
docs
->
(
Just
$
length
docs
(
Just
$
fromIntegral
$
length
docs
,
yieldMany
docs
,
yieldMany
docs
.|
mapC
(
map
$
first
WOS
.
keys
)
.|
mapC
(
map
$
first
WOS
.
keys
)
.|
mapC
(
map
$
both
decodeUtf8
)
.|
mapC
(
map
$
both
decodeUtf8
)
...
@@ -130,8 +130,8 @@ parseFormatC ft ZIP bs = do
...
@@ -130,8 +130,8 @@ parseFormatC ft ZIP bs = do
let
lenghts
=
fst
<$>
contents
let
lenghts
=
fst
<$>
contents
let
contents'
=
snd
<$>
contents
let
contents'
=
snd
<$>
contents
let
totalLength
=
sum
$
sum
<$>
lenghts
-- Trick: sum (Just 1) = 1, sum Nothing = 0
let
totalLength
=
sum
$
sum
<$>
lenghts
-- Trick: sum (Just 1) = 1, sum Nothing = 0
pure
$
Right
$
(
Just
totalLength
pure
$
Right
(
Just
totalLength
,
sequenceConduits
contents'
>>
pure
()
)
-- .| mapM_C (printDebug "[parseFormatC] doc")
,
sequenceConduits
contents'
>>
pure
()
)
-- .| mapM_C (printDebug "[parseFormatC] doc")
_
->
pure
$
Left
$
unpack
$
intercalate
"
\n
"
$
pack
<$>
errs
_
->
pure
$
Left
$
unpack
$
intercalate
"
\n
"
$
pack
<$>
errs
parseFormatC
_
_
_
=
undefined
parseFormatC
_
_
_
=
undefined
...
...
src/Gargantext/Core/Text/Corpus/Parsers/CSV.hs
View file @
06477f7b
...
@@ -472,7 +472,7 @@ parseCsvC bs = do
...
@@ -472,7 +472,7 @@ parseCsvC bs = do
Right
res
->
Right
res
Right
res
->
Right
res
case
result
of
case
result
of
Left
err
->
Left
err
Left
err
->
Left
err
Right
r
->
Right
$
(
Just
$
length
snd
r
,
(
yieldMany
$
snd
r
)
.|
mapC
csv2doc
)
Right
r
->
Right
$
(
Just
$
Prelude
.
fromIntegral
$
Prelude
.
length
$
snd
r
,
(
yieldMany
$
snd
r
)
.|
mapC
csv2doc
)
------------------------------------------------------------------------
------------------------------------------------------------------------
-- Csv v3 weighted for phylo
-- Csv v3 weighted for phylo
...
...
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