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
b74120d1
Commit
b74120d1
authored
Apr 05, 2023
by
Alexandre Delanoë
Browse files
Options
Browse Files
Download
Plain Diff
Merge remote-tracking branch 'origin/191-dev-list-upload-fixes' into dev-merge
parents
151b9174
e0a52fb1
Changes
2
Show whitespace changes
Inline
Side-by-side
Showing
2 changed files
with
42 additions
and
38 deletions
+42
-38
gargantext.cabal
gargantext.cabal
+0
-1
List.hs
src/Gargantext/API/Ngrams/List.hs
+42
-37
No files found.
gargantext.cabal
View file @
b74120d1
...
...
@@ -45,7 +45,6 @@ library
Gargantext.API.Node.Share
Gargantext.API.Prelude
Gargantext.Core
Gargantext.Core.NLP
Gargantext.Core.Methods.Similarities
Gargantext.Core.NodeStory
Gargantext.Core.Text
...
...
src/Gargantext/API/Ngrams/List.hs
View file @
b74120d1
...
...
@@ -25,6 +25,7 @@ import Data.Text (Text, concat, pack, splitOn)
import
Data.Vector
(
Vector
)
import
Gargantext.API.Admin.EnvTypes
(
Env
,
GargJob
(
..
))
import
Gargantext.API.Admin.Orchestrator.Types
import
Gargantext.API.Job
(
jobLogFailTotalWithMessage
,
jobLogSuccess
)
import
Gargantext.API.Ngrams
(
setListNgrams
)
import
Gargantext.API.Ngrams.List.Types
import
Gargantext.API.Ngrams.Prelude
(
getNgramsList
)
...
...
@@ -235,10 +236,10 @@ postAsync' l (WithJsonFile m _) logStatus = do
------------------------------------------------------------------------
readCsvText
::
Text
->
[(
Text
,
Text
,
Text
)]
readCsvText
::
Text
->
Either
Text
[(
Text
,
Text
,
Text
)]
readCsvText
t
=
case
eDec
of
Left
_
->
[]
Right
dec
->
Vec
.
toList
dec
Left
err
->
Left
$
pack
err
Right
dec
->
Right
$
Vec
.
toList
dec
where
lt
=
BSL
.
fromStrict
$
P
.
encodeUtf8
t
eDec
=
Csv
.
decodeWith
...
...
@@ -268,12 +269,15 @@ parseCsvData lst = Map.fromList $ conv <$> lst
csvPost
::
FlowCmdM
env
err
m
=>
ListId
->
Text
->
m
Bool
->
m
(
Either
Text
()
)
csvPost
l
m
=
do
-- printDebug "[csvPost] l" l
-- printDebug "[csvPost] m" m
-- status label forms
let
lst
=
readCsvText
m
let
eLst
=
readCsvText
m
case
eLst
of
Left
err
->
pure
$
Left
err
Right
lst
->
do
let
p
=
parseCsvData
lst
--printDebug "[csvPost] lst" lst
-- printDebug "[csvPost] p" p
...
...
@@ -283,35 +287,36 @@ csvPost l m = do
let
corpus_id
=
fromMaybe
(
panic
""
)
(
_node_parent_id
corpus_node
)
_
<-
reIndexWith
corpus_id
l
NgramsTerms
(
Set
.
fromList
[
MapTerm
,
CandidateTerm
])
pure
True
pure
$
Right
()
------------------------------------------------------------------------
csvPostAsync
::
ServerT
CSVAPI
(
GargM
Env
GargError
)
csvPostAsync
lId
=
serveJobsAPI
UpdateNgramsListJobCSV
$
\
jHandle
f
@
(
WithTextFile
_ft
_
_n
)
->
do
serveJobsAPI
UpdateNgramsListJobCSV
$
\
jHandle
f
->
do
let
log''
x
=
do
-- printDebug "[csvPostAsync] filetype"
ft
-- printDebug "[csvPostAsync] name"
n
-- printDebug "[csvPostAsync] filetype"
(_wtf_filetype f)
-- printDebug "[csvPostAsync] name"
(_wtf_name f)
jobHandleLogger
jHandle
x
csvPostAsync'
lId
f
log''
csvPostAsync'
::
FlowCmdM
env
err
m
=>
ListId
->
WithTextFile
->
(
JobLog
->
m
()
)
->
m
JobLog
csvPostAsync'
l
(
WithTextFile
_
m
_
)
logStatus
=
do
logStatus
JobLog
{
_scst_succeeded
=
Just
0
let
jl
=
JobLog
{
_scst_succeeded
=
Just
0
,
_scst_failed
=
Just
0
,
_scst_remaining
=
Just
1
,
_scst_events
=
Just
[]
}
_r
<-
csvPost
l
m
log''
jl
ePost
<-
csvPost
lId
(
_wtf_data
f
)
let
jlNew
=
case
ePost
of
Left
err
->
jobLogFailTotalWithMessage
err
jl
Right
()
->
jobLogSuccess
jl
printDebug
"[csvPostAsync] job ended with joblog: "
jlNew
log''
jlNew
pure
jlNew
pure
JobLog
{
_scst_succeeded
=
Just
1
,
_scst_failed
=
Just
0
,
_scst_remaining
=
Just
0
,
_scst_events
=
Just
[]
}
------------------------------------------------------------------------
-- | This is for debugging the CSV parser in the REPL
importCsvFile
::
FlowCmdM
env
err
m
=>
ListId
->
P
.
FilePath
->
m
(
Either
Text
()
)
importCsvFile
lId
fp
=
do
contents
<-
liftBase
$
P
.
readFile
fp
csvPost
lId
contents
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