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
159
Issues
159
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
c999db60
Verified
Commit
c999db60
authored
Feb 17, 2025
by
Przemyslaw Kaminski
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
[temp file] fix tests
parent
2796048c
Pipeline
#7325
passed with stages
in 61 minutes and 26 seconds
Changes
3
Pipelines
1
Hide whitespace changes
Inline
Side-by-side
Showing
3 changed files
with
18 additions
and
18 deletions
+18
-18
New.hs
src/Gargantext/API/Node/Corpus/New.hs
+5
-8
Routes.hs
src/Gargantext/API/Routes.hs
+0
-1
Prelude.hs
src/Gargantext/Database/Prelude.hs
+13
-9
No files found.
src/Gargantext/API/Node/Corpus/New.hs
View file @
c999db60
...
@@ -23,11 +23,9 @@ module Gargantext.API.Node.Corpus.New
...
@@ -23,11 +23,9 @@ module Gargantext.API.Node.Corpus.New
import
Conduit
((
.|
),
yieldMany
,
mapMC
,
mapC
,
transPipe
)
import
Conduit
((
.|
),
yieldMany
,
mapMC
,
mapC
,
transPipe
)
import
Control.Exception.Safe
(
MonadMask
)
import
Control.Exception.Safe
(
MonadMask
)
import
Control.Lens
(
view
,
non
)
import
Control.Lens
(
view
,
non
)
import
Data.ByteString.Lazy
qualified
as
BSL
import
Data.Conduit.Internal
(
zipSources
)
import
Data.Conduit.Internal
(
zipSources
)
import
Data.Swagger
(
ToSchema
(
..
)
)
import
Data.Swagger
(
ToSchema
(
..
)
)
import
Data.Text
qualified
as
T
import
Data.Text
qualified
as
T
import
Data.Text.Encoding
qualified
as
TE
import
Database.PostgreSQL.Simple.LargeObjects
qualified
as
PSQL
import
Database.PostgreSQL.Simple.LargeObjects
qualified
as
PSQL
import
Gargantext.API.Admin.Orchestrator.Types
qualified
as
API
import
Gargantext.API.Admin.Orchestrator.Types
qualified
as
API
import
Gargantext.API.Ngrams
(
commitStatePatch
,
Versioned
(
..
))
import
Gargantext.API.Ngrams
(
commitStatePatch
,
Versioned
(
..
))
...
@@ -53,7 +51,7 @@ import Gargantext.Database.Admin.Types.Hyperdata.Document ( ToHyperdataDocument(
...
@@ -53,7 +51,7 @@ import Gargantext.Database.Admin.Types.Hyperdata.Document ( ToHyperdataDocument(
import
Gargantext.Database.Admin.Types.Hyperdata.File
(
HyperdataFile
(
..
)
)
import
Gargantext.Database.Admin.Types.Hyperdata.File
(
HyperdataFile
(
..
)
)
import
Gargantext.Database.Admin.Types.Node
(
CorpusId
,
NodeType
(
..
),
ParentId
)
import
Gargantext.Database.Admin.Types.Node
(
CorpusId
,
NodeType
(
..
),
ParentId
)
import
Gargantext.Database.GargDB
qualified
as
GargDB
import
Gargantext.Database.GargDB
qualified
as
GargDB
import
Gargantext.Database.Prelude
(
readLargeObject
ViaTempFile
)
import
Gargantext.Database.Prelude
(
readLargeObject
)
import
Gargantext.Database.Query.Table.Node
(
getNodeWith
,
getOrMkList
)
import
Gargantext.Database.Query.Table.Node
(
getNodeWith
,
getOrMkList
)
import
Gargantext.Database.Query.Table.Node.UpdateOpaleye
(
updateHyperdata
)
import
Gargantext.Database.Query.Table.Node.UpdateOpaleye
(
updateHyperdata
)
import
Gargantext.Database.Query.Tree.Root
(
MkCorpusUser
(
MkCorpusUserNormalCorpusIds
))
import
Gargantext.Database.Query.Tree.Root
(
MkCorpusUser
(
MkCorpusUserNormalCorpusIds
))
...
@@ -248,10 +246,9 @@ addToCorpusWithTempFile user cid nwtf jobHandle = do
...
@@ -248,10 +246,9 @@ addToCorpusWithTempFile user cid nwtf jobHandle = do
-- TODO granularity of the logStatus
-- TODO granularity of the logStatus
let
oId
=
PSQL
.
Oid
$
fromIntegral
$
nwtf
^.
wtf_file_oid
let
oId
=
PSQL
.
Oid
$
fromIntegral
$
nwtf
^.
wtf_file_oid
(
data
''
,
size
)
<-
readLargeObjectViaTempFile
oId
data
'
<
-
readLargeObject
oId
let
data
'
=
BSL
.
toStrict
data
''
-- $(logLocM) DEBUG $ "[addToCorpusWithTempFile] size: " <> show size
$
(
logLocM
)
DEBUG
$
"[addToCorpusWithTempFile] size: "
<>
show
size
-- $(logLocM) DEBUG $ "[addToCorpusWithTempFile] data': " <> TE.decodeUtf8 data'
$
(
logLocM
)
DEBUG
$
"[addToCorpusWithTempFile] data': "
<>
TE
.
decodeUtf8
data
'
eDocsC
<-
liftBase
$
parseC
(
nwtf
^.
wtf_fileformat
)
data
'
eDocsC
<-
liftBase
$
parseC
(
nwtf
^.
wtf_fileformat
)
data
'
case
eDocsC
of
case
eDocsC
of
Right
(
count
,
docsC
)
->
do
Right
(
count
,
docsC
)
->
do
...
@@ -297,7 +294,7 @@ addToCorpusWithTempFile user cid nwtf jobHandle = do
...
@@ -297,7 +294,7 @@ addToCorpusWithTempFile user cid nwtf jobHandle = do
markComplete
jobHandle
markComplete
jobHandle
Left
parseErr
->
do
Left
parseErr
->
do
$
(
logLocM
)
ERROR
$
"[addToCorpusWithTempFile] parse error: "
<>
(
Parser
.
_ParseFormatError
parseErr
)
$
(
logLocM
)
ERROR
$
"[addToCorpusWithTempFile] parse error: "
<>
Parser
.
_ParseFormatError
parseErr
markFailed
(
Just
parseErr
)
jobHandle
markFailed
(
Just
parseErr
)
jobHandle
{-
{-
...
...
src/Gargantext/API/Routes.hs
View file @
c999db60
...
@@ -75,7 +75,6 @@ addCorpusWithQuery user =
...
@@ -75,7 +75,6 @@ addCorpusWithQuery user =
-- | Uses temporary file stored in postgres to add that file to a corpus
-- | Uses temporary file stored in postgres to add that file to a corpus
addWithTempFileApi
::
AuthenticatedUser
addWithTempFileApi
::
AuthenticatedUser
->
Named
.
AddWithTempFile
(
AsServerT
(
GargM
Env
BackendInternalError
))
->
Named
.
AddWithTempFile
(
AsServerT
(
GargM
Env
BackendInternalError
))
-- -> WorkerAPI '[FormUrlEncoded] NewWithForm (AsServerT m)
addWithTempFileApi
authenticatedUser
=
addWithTempFileApi
authenticatedUser
=
Named
.
AddWithTempFile
{
Named
.
AddWithTempFile
{
addWithTempFileEp
=
\
cId
->
addWithTempFileEp
=
\
cId
->
...
...
src/Gargantext/Database/Prelude.hs
View file @
c999db60
...
@@ -9,6 +9,7 @@ Portability : POSIX
...
@@ -9,6 +9,7 @@ Portability : POSIX
-}
-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE ScopedTypeVariables #-}
...
@@ -285,31 +286,34 @@ createLargeObject bs = mkCmd $ \c -> PGS.withTransaction c $ do
...
@@ -285,31 +286,34 @@ createLargeObject bs = mkCmd $ \c -> PGS.withTransaction c $ do
PSQL
.
loClose
c
loFd
PSQL
.
loClose
c
loFd
pure
oId
pure
oId
readLargeObject
::
PSQL
.
Oid
->
DBCmd
err
(
BSL
.
ByteString
,
Int
)
readLargeObject
::
PSQL
.
Oid
->
DBCmd
err
BS
.
ByteString
readLargeObject
oId
=
mkCmd
$
\
c
->
PGS
.
withTransaction
c
$
do
readLargeObject
oId
=
mkCmd
$
\
c
->
PGS
.
withTransaction
c
$
do
loFd
<-
PSQL
.
loOpen
c
oId
PSQL
.
ReadMode
loFd
<-
PSQL
.
loOpen
c
oId
PSQL
.
ReadMode
let
chunkSize
=
1024
let
chunkSize
=
1024
let
readChunks
tell
=
do
let
readChunks
tell
=
do
c'
<-
PSQL
.
loRead
c
loFd
chunkSize
c'
<-
PSQL
.
loRead
c
loFd
chunkSize
tell'
<-
PSQL
.
loTell
c
loFd
tell'
<-
PSQL
.
loTell
c
loFd
putText
$
"[readLargeObject] tell': "
<>
show
tell'
if
tell
==
tell'
then
if
tell
==
tell'
then
pure
([
c'
],
tell
)
pure
([
c'
],
tell
)
else
do
else
do
(
cs'
,
tell''
)
<-
readChunks
tell'
(
cs'
,
tell''
)
<-
readChunks
tell'
pure
(
c'
:
cs'
,
tell''
)
pure
(
c'
:
cs'
,
tell''
)
(
chunks
,
size
)
<-
readChunks
0
(
chunks
,
_size
)
<-
readChunks
0
pure
(
BSL
.
fromChunks
chunks
,
size
)
let
s
=
force
BSL
.
toStrict
$
BSL
.
fromChunks
chunks
PSQL
.
loClose
c
loFd
pure
s
readLargeObjectViaTempFile
::
(
CES
.
MonadMask
m
,
IsDBCmd
env
err
m
)
readLargeObjectViaTempFile
::
(
CES
.
MonadMask
m
,
IsDBCmd
env
err
m
)
=>
PSQL
.
Oid
->
m
(
BSL
.
ByteString
,
Int
)
=>
PSQL
.
Oid
->
m
BS
.
ByteString
readLargeObjectViaTempFile
oId
=
readLargeObjectViaTempFile
oId
=
do
CES
.
bracket
(
liftBase
$
emptySystemTempFile
"large-object"
)
CES
.
bracket
(
liftBase
$
emptySystemTempFile
"large-object"
)
(
liftBase
.
removeFile
)
(
liftBase
.
removeFile
)
(
\
fp
->
do
(
\
fp
->
do
mkCmd
$
\
c
->
PSQL
.
loExport
c
oId
fp
mkCmd
$
\
c
->
withTransaction
c
$
\
_
->
PSQL
.
loExport
c
oId
fp
c
<-
liftBase
$
BSL
.
readFile
fp
!
contents
<-
liftBase
$
BS
.
readFile
fp
pure
(
c
,
fromIntegral
$
BSL
.
length
c
))
pure
contents
)
where
withTransaction
c
=
CES
.
bracket
(
PGS
.
begin
c
)
(
\
_
->
PGS
.
rollback
c
)
removeLargeObject
::
Int
->
DBCmd
err
()
removeLargeObject
::
Int
->
DBCmd
err
()
removeLargeObject
oId
=
mkCmd
$
\
c
->
do
removeLargeObject
oId
=
mkCmd
$
\
c
->
do
...
...
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