Skip to content
Projects
Groups
Snippets
Help
Loading...
Help
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
H
haskell-gargantext
Project
Project
Details
Activity
Releases
Cycle Analytics
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Charts
Issues
0
Issues
0
List
Board
Labels
Milestones
Merge Requests
0
Merge Requests
0
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
Przemyslaw Kaminski
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
Changes
3
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
Right
decoded
->
decoded
eDocsC
<-
liftBase
$
parseC
ff
data
'
case
eDocsC
of
Right
docsC
->
do
Right
(
mCount
,
docsC
)
->
do
-- TODO Add progress (jobStatus) update for docs - this is a
-- long action
...
...
@@ -315,9 +315,9 @@ addToCorpusWithForm user cid (NewWithForm ft ff d l _n) logStatus jobLog = do
(
Multi
$
fromMaybe
EN
l
)
Nothing
--(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)
(
logStatus
)
logStatus
printDebug
"Extraction finished : "
cid
printDebug
"sending email"
(
"xxxxxxxxxxxxxxxxxxxxx"
::
Text
)
...
...
src/Gargantext/Core/Text/Corpus/Parsers.hs
View file @
06477f7b
...
...
@@ -85,20 +85,20 @@ parseFormatC :: MonadBaseControl IO m
->
DB
.
ByteString
->
m
(
Either
Prelude
.
String
(
Maybe
Integer
,
ConduitT
()
HyperdataDocument
IO
()
))
parseFormatC
CsvGargV3
Plain
bs
=
do
eParsedC
<-
parseCsvC
$
DBL
.
fromStrict
bs
let
eParsedC
=
parseCsvC
$
DBL
.
fromStrict
bs
case
eParsedC
of
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
eParsedC
<-
parseCsvC
$
DBL
.
fromStrict
bs
let
eParsedC
=
parseCsvC
$
DBL
.
fromStrict
bs
case
eParsedC
of
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
--docs <- enrichWith RisPresse
let
eDocs
=
runParser'
RisPresse
bs
pure
$
(
\
docs
->
(
Just
$
length
docs
(
Just
$
fromIntegral
$
length
docs
,
yieldMany
docs
.|
mapC
presseEnrich
.|
mapC
(
map
$
both
decodeUtf8
)
...
...
@@ -106,7 +106,7 @@ parseFormatC RisPresse Plain bs = do
parseFormatC
WOS
Plain
bs
=
do
let
eDocs
=
runParser'
WOS
bs
pure
$
(
\
docs
->
(
Just
$
length
docs
(
Just
$
fromIntegral
$
length
docs
,
yieldMany
docs
.|
mapC
(
map
$
first
WOS
.
keys
)
.|
mapC
(
map
$
both
decodeUtf8
)
...
...
@@ -130,8 +130,8 @@ parseFormatC ft ZIP bs = do
let
lenghts
=
fst
<$>
contents
let
contents'
=
snd
<$>
contents
let
totalLength
=
sum
$
sum
<$>
lenghts
-- Trick: sum (Just 1) = 1, sum Nothing = 0
pure
$
Right
$
(
Just
totalLength
,
sequenceConduits
contents'
>>
pure
()
)
-- .| mapM_C (printDebug "[parseFormatC] doc")
pure
$
Right
(
Just
totalLength
,
sequenceConduits
contents'
>>
pure
()
)
-- .| mapM_C (printDebug "[parseFormatC] doc")
_
->
pure
$
Left
$
unpack
$
intercalate
"
\n
"
$
pack
<$>
errs
parseFormatC
_
_
_
=
undefined
...
...
src/Gargantext/Core/Text/Corpus/Parsers/CSV.hs
View file @
06477f7b
...
...
@@ -472,7 +472,7 @@ parseCsvC bs = do
Right
res
->
Right
res
case
result
of
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
...
...
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