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
191
Issues
191
List
Board
Labels
Milestones
Merge Requests
8
Merge Requests
8
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
a237e7b1
Verified
Commit
a237e7b1
authored
Sep 08, 2025
by
Przemyslaw Kaminski
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
[flow] human friendly servant client error
parent
8e22d2b4
Pipeline
#7866
passed with stages
in 58 minutes and 13 seconds
Changes
2
Pipelines
1
Show whitespace changes
Inline
Side-by-side
Showing
2 changed files
with
24 additions
and
9 deletions
+24
-9
Flow.hs
src/Gargantext/Database/Action/Flow.hs
+14
-6
Error.hs
src/Gargantext/Utils/Jobs/Error.hs
+10
-3
No files found.
src/Gargantext/Database/Action/Flow.hs
View file @
a237e7b1
...
@@ -113,6 +113,7 @@ import Gargantext.Database.Types
...
@@ -113,6 +113,7 @@ import Gargantext.Database.Types
import
Gargantext.Prelude
hiding
(
catch
,
onException
,
to
)
import
Gargantext.Prelude
hiding
(
catch
,
onException
,
to
)
import
Gargantext.System.Logging
(
logLocM
,
LogLevel
(
DEBUG
,
ERROR
),
MonadLogger
)
import
Gargantext.System.Logging
(
logLocM
,
LogLevel
(
DEBUG
,
ERROR
),
MonadLogger
)
import
Gargantext.Utils.Jobs.Monad
(
JobHandle
,
MonadJobStatus
(
..
),
markFailureNoErr
)
import
Gargantext.Utils.Jobs.Monad
(
JobHandle
,
MonadJobStatus
(
..
),
markFailureNoErr
)
import
Servant.Client.Core
(
ClientError
)
------------------------------------------------------------------------
------------------------------------------------------------------------
-- Imports for upgrade function
-- Imports for upgrade function
...
@@ -298,14 +299,21 @@ flow c mkCorpusUser la mfslw (count, docsC) jobHandle = do
...
@@ -298,14 +299,21 @@ flow c mkCorpusUser la mfslw (count, docsC) jobHandle = do
(
_userId
,
userCorpusId
,
listId
,
msgs
)
<-
runDBTx
$
createNodes
cfg
mkCorpusUser
c
(
_userId
,
userCorpusId
,
listId
,
msgs
)
<-
runDBTx
$
createNodes
cfg
mkCorpusUser
c
forM_
msgs
ce_notify
forM_
msgs
ce_notify
-- TODO if public insertMasterDocs else insertUserDocs
-- TODO if public insertMasterDocs else insertUserDocs
(
runConduit
$
zipSources
(
yieldMany
([
1
..
]
::
[
Int
]))
docsC
runConduit
(
zipSources
(
yieldMany
([
1
..
]
::
[
Int
]))
docsC
.|
CList
.
chunksOf
5
.|
CList
.
chunksOf
5
.|
mapM_C
(
addDocumentsWithProgress
userCorpusId
)
.|
mapM_C
(
addDocumentsWithProgress
userCorpusId
)
.|
sinkNull
)
`
CES
.
catch
`
(
\
(
e
::
SomeException
)
->
do
.|
sinkNull
)
`
CES
.
catches
`
$
(
logLocM
)
ERROR
$
"Exception during API call: "
<>
show
e
[
CES
.
Handler
$
\
(
e
::
ClientError
)
->
do
$
(
logLocM
)
ERROR
(
"Client error: "
<>
show
e
::
Text
)
markFailure
1
(
Just
e
)
jobHandle
-- ignore this and proceed with list generation
pure
()
,
CES
.
Handler
$
\
(
e
::
SomeException
)
->
do
$
(
logLocM
)
ERROR
(
"Exception during API call: "
<>
show
e
::
Text
)
markFailureNoErr
1
jobHandle
markFailureNoErr
1
jobHandle
-- ignore this and proceed with list generation
-- ignore this and proceed with list generation
pure
()
)
pure
()
]
let
u
=
userFromMkCorpusUser
mkCorpusUser
let
u
=
userFromMkCorpusUser
mkCorpusUser
...
...
src/Gargantext/Utils/Jobs/Error.hs
View file @
a237e7b1
...
@@ -14,9 +14,9 @@ module Gargantext.Utils.Jobs.Error
...
@@ -14,9 +14,9 @@ module Gargantext.Utils.Jobs.Error
,
HumanFriendlyErrorText
(
..
)
,
HumanFriendlyErrorText
(
..
)
)
where
)
where
import
Prelude
import
Gargantext.
Prelude
import
Data.
Void
import
Data.
Text
qualified
as
T
import
qualified
Data.Text
as
T
import
Servant.Client.Core
(
ClientError
(
..
))
-- | This class represents the concept of \"human friendly strings\", by which we mean
-- | This class represents the concept of \"human friendly strings\", by which we mean
-- error messages and/or diagnostics which needs to be displayed to the end users, and, as such:
-- error messages and/or diagnostics which needs to be displayed to the end users, and, as such:
...
@@ -43,3 +43,10 @@ instance ToHumanFriendlyError HumanFriendlyErrorText where
...
@@ -43,3 +43,10 @@ instance ToHumanFriendlyError HumanFriendlyErrorText where
-- /N.B/ Don't get fooled by this instance, it's just to help inference in case we use \"markFailed Nothing\".
-- /N.B/ Don't get fooled by this instance, it's just to help inference in case we use \"markFailed Nothing\".
instance
ToHumanFriendlyError
Void
where
instance
ToHumanFriendlyError
Void
where
mkHumanFriendly
=
absurd
mkHumanFriendly
=
absurd
instance
ToHumanFriendlyError
ClientError
where
mkHumanFriendly
(
FailureResponse
_
_
)
=
"Server returned an error response"
mkHumanFriendly
(
DecodeFailure
d
_
)
=
"Decode failure: "
<>
d
mkHumanFriendly
(
UnsupportedContentType
mt
_
)
=
"Unsupported content type: "
<>
show
mt
mkHumanFriendly
(
InvalidContentTypeHeader
_
)
=
"Invalid content type header"
mkHumanFriendly
(
ConnectionError
_
)
=
"Connection error"
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